{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Simplex.Chat.Library.Commands where

import Control.Applicative (optional, (<|>))
import Control.Concurrent.STM (retry)
import Control.Logger.Simple
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import qualified Data.Aeson as J
import Data.Attoparsec.ByteString.Char8 (Parser)
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.Attoparsec.Combinator as A
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char
import Data.Constraint (Dict (..))
import Data.Either (fromRight, partitionEithers, rights)
import Data.Foldable (foldr')
import Data.Functor (($>))
import Data.Int (Int64)
import Data.List (dropWhileEnd, find, foldl', isSuffixOf, partition, sortOn, zipWith4)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
import Data.Time.Clock (UTCTime, getCurrentTime, nominalDay)
import Data.Type.Equality
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as V4
import Simplex.Chat.Library.Subscriber
import Simplex.Chat.Call
import Simplex.Chat.Controller
import Simplex.Chat.Files
import Simplex.Chat.Markdown
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.Operators
import Simplex.Chat.Options
import Simplex.Chat.ProfileGenerator (generateRandomProfile)
import Simplex.Chat.Protocol
import Simplex.Chat.Remote
import Simplex.Chat.Remote.Types
import Simplex.Chat.Library.Internal
import Simplex.Chat.Stats
import Simplex.Chat.Store
import Simplex.Chat.Store.AppSettings
import Simplex.Chat.Store.ContactRequest
import Simplex.Chat.Store.Connections
import Simplex.Chat.Store.Delivery
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Files
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.Messages
import Simplex.Chat.Store.NoteFolders
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Util (liftIOEither, zipWith3')
import qualified Simplex.Chat.Util as U
import Simplex.FileTransfer.Description (FileDescriptionURI (..), maxFileSize, maxFileSizeHard)
import Simplex.Messaging.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
import Simplex.Messaging.Agent.Store.Interface (getCurrentMigrations)
import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), NetworkTimeout (..), SMPWebPortServers (..), SocksMode (SMAlways), textToHostMode)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQEncOff, pattern PQSupportOff, pattern PQSupportOn)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (base64P)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport.Client (defaultSocksProxyWithAuth)
import Simplex.Messaging.Util
import Simplex.Messaging.Version
import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..))
import Simplex.RemoteControl.Types (RCCtrlAddress (..))
import System.Exit (ExitCode, exitSuccess)
import System.FilePath (takeExtension, takeFileName, (</>))
import System.IO (Handle, IOMode (..))
import System.Random (randomRIO)
import UnliftIO.Async
import UnliftIO.Concurrent (forkIO, threadDelay)
import UnliftIO.Directory
import qualified UnliftIO.Exception as E
import UnliftIO.IO (hClose)
import UnliftIO.STM
#if defined(dbPostgres)
import Data.Bifunctor (bimap, second)
import Simplex.Messaging.Agent.Client (SubInfo (..), getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary)
#else
import Data.Bifunctor (bimap, first, second)
import qualified Data.ByteArray as BA
import qualified Database.SQLite.Simple as SQL
import Simplex.Chat.Archive
import Simplex.Messaging.Agent.Client (SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary)
import Simplex.Messaging.Agent.Store.Common (withConnection)
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
#endif

_defaultNtfServers :: [NtfServer]
_defaultNtfServers :: [NtfServer]
_defaultNtfServers =
  [ -- "ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,5ex3mupcazy3zlky64ab27phjhijpemsiby33qzq3pliejipbtx5xgad.onion"
    Item [NtfServer]
NtfServer
"ntf://KmpZNNXiVZJx_G2T7jRUmDFxWXM3OAnunz3uLT0tqAA=@ntf3.simplex.im,pxculznuryunjdvtvh6s6szmanyadumpbmvevgdpe4wk5c65unyt4yid.onion",
    Item [NtfServer]
NtfServer
"ntf://CJ5o7X6fCxj2FFYRU2KuCo70y4jSqz7td2HYhLnXWbU=@ntf4.simplex.im,wtvuhdj26jwprmomnyfu5wfuq2hjkzfcc72u44vi6gdhrwxldt6xauad.onion"
  ]

maxImageSize :: Integer
maxImageSize :: Integer
maxImageSize = Integer
261120 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 -- auto-receive on mobiles

imageExtensions :: [String]
imageExtensions :: [String]
imageExtensions = [String
Item [String]
".jpg", String
Item [String]
".jpeg", String
Item [String]
".png", String
Item [String]
".gif"]

fixedImagePreview :: ImageData
fixedImagePreview :: ImageData
fixedImagePreview = Text -> ImageData
ImageData Text
"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAAXNSR0IArs4c6QAAAKVJREFUeF7t1kENACEUQ0FQhnVQ9lfGO+xggITQdvbMzArPey+8fa3tAfwAEdABZQspQStgBssEcgAIkSAJkiAJljtEgiRIgmUCSZAESZAESZAEyx0iQRIkwTKBJEiCv5fgvTd1wDmn7QAP4AeIgA4oW0gJWgEzWCZwbQ7gAA7ggLKFOIADOKBMIAeAEAmSIAmSYLlDJEiCJFgmkARJkARJ8N8S/ADTZUewBvnTOQAAAABJRU5ErkJggg=="

imageFilePrefix :: String
imageFilePrefix :: String
imageFilePrefix = String
"IMG_"

voiceFilePrefix :: String
voiceFilePrefix :: String
voiceFilePrefix = String
"voice_"

videoFilePrefix :: String
videoFilePrefix :: String
videoFilePrefix = String
"video_"

-- enableSndFiles has no effect when mainApp is True
startChatController :: Bool -> Bool -> CM' (Async ())
startChatController :: Bool -> Bool -> CM' (Async ())
startChatController Bool
mainApp Bool
enableSndFiles = do
  (ChatController -> AgentClient)
-> ReaderT ChatController IO AgentClient
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> AgentClient
smpAgent ReaderT ChatController IO AgentClient
-> (AgentClient -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ReaderT ChatController IO ()
forall a. IO a -> ReaderT ChatController IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ChatController IO ())
-> (AgentClient -> IO ())
-> AgentClient
-> ReaderT ChatController IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentClient -> IO ()
resumeAgentClient
  Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
mainApp (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ (ChatController -> TVar SubscriptionMode)
-> SubscriptionMode -> ReaderT ChatController IO ()
forall a.
(ChatController -> TVar a) -> a -> ReaderT ChatController IO ()
chatWriteVar' ChatController -> TVar SubscriptionMode
subscriptionMode SubscriptionMode
SMOnlyCreate
  [User]
users <- [User] -> Either ChatError [User] -> [User]
forall b a. b -> Either a b -> b
fromRight [] (Either ChatError [User] -> [User])
-> ReaderT ChatController IO (Either ChatError [User])
-> ReaderT ChatController IO [User]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT ChatError (ReaderT ChatController IO) [User]
-> ReaderT ChatController IO (Either ChatError [User])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [User]
getUsers)
  ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO (Either ChatError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ([User] -> ExceptT ChatError (ReaderT ChatController IO) ()
syncConnections' [User]
users) ReaderT ChatController IO (Either ChatError ())
-> (Either ChatError () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ChatError
e -> IO () -> ReaderT ChatController IO ()
forall a. IO a -> ReaderT ChatController IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ChatController IO ())
-> IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error synchronizing connections: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChatError -> String
forall a. Show a => a -> String
show ChatError
e
    Right ()
_ -> () -> ReaderT ChatController IO ()
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  ReaderT ChatController IO ()
restoreCalls
  TVar (Maybe (Async (), Maybe (Async ())))
s <- (ChatController -> TVar (Maybe (Async (), Maybe (Async ()))))
-> ReaderT
     ChatController IO (TVar (Maybe (Async (), Maybe (Async ()))))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe (Async (), Maybe (Async ())))
agentAsync
  TVar (Maybe (Async (), Maybe (Async ())))
-> ReaderT ChatController IO (Maybe (Async (), Maybe (Async ())))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (Async (), Maybe (Async ())))
s ReaderT ChatController IO (Maybe (Async (), Maybe (Async ())))
-> (Maybe (Async (), Maybe (Async ())) -> CM' (Async ()))
-> CM' (Async ())
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CM' (Async ())
-> ((Async (), Maybe (Async ())) -> CM' (Async ()))
-> Maybe (Async (), Maybe (Async ()))
-> CM' (Async ())
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TVar (Maybe (Async (), Maybe (Async ())))
-> [User] -> CM' (Async ())
start TVar (Maybe (Async (), Maybe (Async ())))
s [User]
users) (Async () -> CM' (Async ())
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Async () -> CM' (Async ()))
-> ((Async (), Maybe (Async ())) -> Async ())
-> (Async (), Maybe (Async ()))
-> CM' (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Async (), Maybe (Async ())) -> Async ()
forall a b. (a, b) -> a
fst)
  where
    syncConnections' :: [User] -> ExceptT ChatError (ReaderT ChatController IO) ()
syncConnections' [User]
users =
      ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((Connection -> IO Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO Bool
shouldSyncConnections) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
        let aUserIds :: [Int64]
aUserIds = (User -> Int64) -> [User] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map User -> Int64
aUserId [User]
users
        [ByteString]
connIds <- [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ByteString]] -> [ByteString])
-> ExceptT ChatError (ReaderT ChatController IO) [[ByteString]]
-> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [User]
-> (User
    -> ExceptT ChatError (ReaderT ChatController IO) [ByteString])
-> ExceptT ChatError (ReaderT ChatController IO) [[ByteString]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [User]
users User -> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
getConnsToSub
        (DatabaseDiff Int64
userDiff, DatabaseDiff ByteString
connDiff) <- (AgentClient
 -> ExceptT
      AgentErrorType IO (DatabaseDiff Int64, DatabaseDiff ByteString))
-> CM (DatabaseDiff Int64, DatabaseDiff ByteString)
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> [Int64]
-> [ByteString]
-> ExceptT
     AgentErrorType IO (DatabaseDiff Int64, DatabaseDiff ByteString)
syncConnections AgentClient
a [Int64]
aUserIds [ByteString]
connIds)
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO ()
setConnectionsSyncTs
        ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ DatabaseDiff AgentUserId -> DatabaseDiff AgentConnId -> ChatEvent
CEvtConnectionsDiff (Int64 -> AgentUserId
AgentUserId (Int64 -> AgentUserId)
-> DatabaseDiff Int64 -> DatabaseDiff AgentUserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseDiff Int64
userDiff) (ByteString -> AgentConnId
AgentConnId (ByteString -> AgentConnId)
-> DatabaseDiff ByteString -> DatabaseDiff AgentConnId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseDiff ByteString
connDiff)
    start :: TVar (Maybe (Async (), Maybe (Async ())))
-> [User] -> CM' (Async ())
start TVar (Maybe (Async (), Maybe (Async ())))
s [User]
users = do
      Async ()
a1 <- ReaderT ChatController IO () -> CM' (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async ReaderT ChatController IO ()
agentSubscriber
      Maybe (Async ())
a2 <-
        if Bool
mainApp
          then Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just (Async () -> Maybe (Async ()))
-> CM' (Async ()) -> ReaderT ChatController IO (Maybe (Async ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ChatController IO () -> CM' (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (Bool -> [User] -> ReaderT ChatController IO ()
subscribeUsers Bool
False [User]
users)
          else Maybe (Async ()) -> ReaderT ChatController IO (Maybe (Async ()))
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Async ())
forall a. Maybe a
Nothing
      STM () -> ReaderT ChatController IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ReaderT ChatController IO ())
-> (Maybe (Async (), Maybe (Async ())) -> STM ())
-> Maybe (Async (), Maybe (Async ()))
-> ReaderT ChatController IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Maybe (Async (), Maybe (Async ())))
-> Maybe (Async (), Maybe (Async ())) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Async (), Maybe (Async ())))
s (Maybe (Async (), Maybe (Async ()))
 -> ReaderT ChatController IO ())
-> Maybe (Async (), Maybe (Async ()))
-> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ (Async (), Maybe (Async ())) -> Maybe (Async (), Maybe (Async ()))
forall a. a -> Maybe a
Just (Async ()
a1, Maybe (Async ())
a2)
      if Bool
mainApp
        then do
          (AgentClient -> Maybe String -> ExceptT AgentErrorType IO ())
-> ReaderT ChatController IO ()
forall {a}.
(AgentClient -> Maybe String -> ExceptT AgentErrorType IO a)
-> ReaderT ChatController IO ()
startXFTP AgentClient -> Maybe String -> ExceptT AgentErrorType IO ()
xftpStartWorkers
          ReaderT ChatController IO ThreadId -> ReaderT ChatController IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT ChatController IO ThreadId
 -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ThreadId
-> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ ReaderT ChatController IO () -> ReaderT ChatController IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (ReaderT ChatController IO ()
 -> ReaderT ChatController IO ThreadId)
-> ReaderT ChatController IO ()
-> ReaderT ChatController IO ThreadId
forall a b. (a -> b) -> a -> b
$ [User] -> ReaderT ChatController IO ()
startFilesToReceive [User]
users
          ReaderT ChatController IO ()
startDeliveryWorkers
          ReaderT ChatController IO ()
startCleanupManager
          ReaderT ChatController IO ThreadId -> ReaderT ChatController IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT ChatController IO ThreadId
 -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ThreadId
-> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ ReaderT ChatController IO () -> ReaderT ChatController IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (ReaderT ChatController IO ()
 -> ReaderT ChatController IO ThreadId)
-> ReaderT ChatController IO ()
-> ReaderT ChatController IO ThreadId
forall a b. (a -> b) -> a -> b
$ (User -> ReaderT ChatController IO ())
-> [User] -> ReaderT ChatController IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ User -> ReaderT ChatController IO ()
startExpireCIs [User]
users
        else Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
enableSndFiles (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ (AgentClient -> Maybe String -> ExceptT AgentErrorType IO ())
-> ReaderT ChatController IO ()
forall {a}.
(AgentClient -> Maybe String -> ExceptT AgentErrorType IO a)
-> ReaderT ChatController IO ()
startXFTP AgentClient -> Maybe String -> ExceptT AgentErrorType IO ()
xftpStartSndWorkers
      Async () -> CM' (Async ())
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Async ()
a1
    startXFTP :: (AgentClient -> Maybe String -> ExceptT AgentErrorType IO a)
-> ReaderT ChatController IO ()
startXFTP AgentClient -> Maybe String -> ExceptT AgentErrorType IO a
startWorkers = do
      Maybe String
tmp <- TVar (Maybe String) -> ReaderT ChatController IO (Maybe String)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar (Maybe String) -> ReaderT ChatController IO (Maybe String))
-> ReaderT ChatController IO (TVar (Maybe String))
-> ReaderT ChatController IO (Maybe String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ChatController -> TVar (Maybe String))
-> ReaderT ChatController IO (TVar (Maybe String))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe String)
tempDirectory
      ExceptT ChatError (ReaderT ChatController IO) a
-> ReaderT ChatController IO (Either ChatError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((AgentClient -> ExceptT AgentErrorType IO a)
-> ExceptT ChatError (ReaderT ChatController IO) a
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO a)
 -> ExceptT ChatError (ReaderT ChatController IO) a)
-> (AgentClient -> ExceptT AgentErrorType IO a)
-> ExceptT ChatError (ReaderT ChatController IO) a
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient -> Maybe String -> ExceptT AgentErrorType IO a
startWorkers AgentClient
a Maybe String
tmp) ReaderT ChatController IO (Either ChatError a)
-> (Either ChatError a -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ChatError
e -> IO () -> ReaderT ChatController IO ()
forall a. IO a -> ReaderT ChatController IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ChatController IO ())
-> IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error starting XFTP workers: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChatError -> String
forall a. Show a => a -> String
show ChatError
e
        Right a
_ -> () -> ReaderT ChatController IO ()
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    startDeliveryWorkers :: ReaderT ChatController IO ()
startDeliveryWorkers =
      ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO (Either ChatError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError (ReaderT ChatController IO) ()
startDeliveryTaskWorkers ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExceptT ChatError (ReaderT ChatController IO) ()
startDeliveryJobWorkers) ReaderT ChatController IO (Either ChatError ())
-> (Either ChatError () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ChatError
e -> IO () -> ReaderT ChatController IO ()
forall a. IO a -> ReaderT ChatController IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ChatController IO ())
-> IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error starting delivery workers: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ChatError -> String
forall a. Show a => a -> String
show ChatError
e
        Right ()
_ -> () -> ReaderT ChatController IO ()
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    startCleanupManager :: ReaderT ChatController IO ()
startCleanupManager = do
      TVar (Maybe (Async ()))
cleanupAsync <- (ChatController -> TVar (Maybe (Async ())))
-> ReaderT ChatController IO (TVar (Maybe (Async ())))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe (Async ()))
cleanupManagerAsync
      TVar (Maybe (Async ()))
-> ReaderT ChatController IO (Maybe (Async ()))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (Async ()))
cleanupAsync ReaderT ChatController IO (Maybe (Async ()))
-> (Maybe (Async ()) -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Async ())
Nothing -> do
          Maybe (Async ())
a <- Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just (Async () -> Maybe (Async ()))
-> CM' (Async ()) -> ReaderT ChatController IO (Maybe (Async ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ChatController IO () -> CM' (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (ReaderT ChatController IO (Either ChatError ())
-> ReaderT ChatController IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT ChatController IO (Either ChatError ())
 -> ReaderT ChatController IO ())
-> ReaderT ChatController IO (Either ChatError ())
-> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO (Either ChatError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT ChatError (ReaderT ChatController IO) ()
cleanupManager)
          STM () -> ReaderT ChatController IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ReaderT ChatController IO ())
-> STM () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe (Async ())) -> Maybe (Async ()) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Async ()))
cleanupAsync Maybe (Async ())
a
        Maybe (Async ())
_ -> () -> ReaderT ChatController IO ()
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    startExpireCIs :: User -> ReaderT ChatController IO ()
startExpireCIs User
user = ReaderT ChatController IO Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ReaderT ChatController IO Bool
shouldExpireChats (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ do
      User -> ReaderT ChatController IO ()
startExpireCIThread User
user
      User -> Bool -> ReaderT ChatController IO ()
setExpireCIFlag User
user Bool
True
      where
        shouldExpireChats :: ReaderT ChatController IO Bool
shouldExpireChats =
          (Either ChatError Bool -> Bool)
-> ReaderT ChatController IO (Either ChatError Bool)
-> ReaderT ChatController IO Bool
forall a b.
(a -> b)
-> ReaderT ChatController IO a -> ReaderT ChatController IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Either ChatError Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False) (ReaderT ChatController IO (Either ChatError Bool)
 -> ReaderT ChatController IO Bool)
-> ReaderT ChatController IO (Either ChatError Bool)
-> ReaderT ChatController IO Bool
forall a b. (a -> b) -> a -> b
$ ExceptT ChatError (ReaderT ChatController IO) Bool
-> ReaderT ChatController IO (Either ChatError Bool)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError (ReaderT ChatController IO) Bool
 -> ReaderT ChatController IO (Either ChatError Bool))
-> ExceptT ChatError (ReaderT ChatController IO) Bool
-> ReaderT ChatController IO (Either ChatError Bool)
forall a b. (a -> b) -> a -> b
$ (Connection -> IO Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO Bool)
 -> ExceptT ChatError (ReaderT ChatController IO) Bool)
-> (Connection -> IO Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
            Int64
ttl <- Connection -> User -> IO Int64
getChatItemTTL Connection
db User
user
            Int
ttlCount <- Connection -> User -> IO Int
getChatTTLCount Connection
db User
user
            Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int64
ttl Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
|| Int
ttlCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

getConnsToSub :: User -> CM [ConnId]
getConnsToSub :: User -> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
getConnsToSub User
user =
  (Connection -> IO [ByteString])
-> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [ByteString])
 -> ExceptT ChatError (ReaderT ChatController IO) [ByteString])
-> (Connection -> IO [ByteString])
-> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
    [ByteString]
ctConnIds <- Connection -> User -> Bool -> IO [ByteString]
getContactConnsToSub Connection
db User
user Bool
False
    [ByteString]
uclConnIds <- Connection -> User -> Bool -> IO [ByteString]
getUCLConnsToSub Connection
db User
user Bool
False
    [ByteString]
memberConnIds <- Connection -> User -> Bool -> IO [ByteString]
getMemberConnsToSub Connection
db User
user Bool
False
    [ByteString]
pendingConnIds <- Connection -> User -> Bool -> IO [ByteString]
getPendingConnsToSub Connection
db User
user Bool
False
    [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> IO [ByteString])
-> [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
ctConnIds [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
uclConnIds [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
memberConnIds [ByteString] -> [ByteString] -> [ByteString]
forall a. Semigroup a => a -> a -> a
<> [ByteString]
pendingConnIds

subscribeUsers :: Bool -> [User] -> CM' ()
subscribeUsers :: Bool -> [User] -> ReaderT ChatController IO ()
subscribeUsers Bool
onlyNeeded [User]
users = do
  let activeUserId_ :: Maybe Int64
activeUserId_ = (\User {agentUserId :: User -> AgentUserId
agentUserId = AgentUserId Int64
uId} -> Int64
uId) (User -> Int64) -> Maybe User -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (User -> Bool) -> [User] -> Maybe User
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find User -> Bool
activeUser [User]
users
  (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient -> Bool -> Maybe Int64 -> ExceptT AgentErrorType IO ()
subscribeAllConnections AgentClient
a Bool
onlyNeeded Maybe Int64
activeUserId_) ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> m a) -> m a
`catchAllErrors'` ChatError -> ReaderT ChatController IO ()
eToView'

startFilesToReceive :: [User] -> CM' ()
startFilesToReceive :: [User] -> ReaderT ChatController IO ()
startFilesToReceive [User]
users = do
  let ([User]
us, [User]
us') = (User -> Bool) -> [User] -> ([User], [User])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition User -> Bool
activeUser [User]
users
  [User] -> ReaderT ChatController IO ()
startReceive [User]
us
  [User] -> ReaderT ChatController IO ()
startReceive [User]
us'
  where
    startReceive :: [User] -> CM' ()
    startReceive :: [User] -> ReaderT ChatController IO ()
startReceive = (User -> ReaderT ChatController IO (Either ChatError ()))
-> [User] -> ReaderT ChatController IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((User -> ReaderT ChatController IO (Either ChatError ()))
 -> [User] -> ReaderT ChatController IO ())
-> (User -> ReaderT ChatController IO (Either ChatError ()))
-> [User]
-> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO (Either ChatError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ReaderT ChatController IO (Either ChatError ()))
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> User
-> ReaderT ChatController IO (Either ChatError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> ExceptT ChatError (ReaderT ChatController IO) ()
startReceiveUserFiles

startReceiveUserFiles :: User -> CM ()
startReceiveUserFiles :: User -> ExceptT ChatError (ReaderT ChatController IO) ()
startReceiveUserFiles User
user = do
  [RcvFileTransfer]
filesToReceive <- (Connection -> IO [RcvFileTransfer]) -> CM [RcvFileTransfer]
forall a. (Connection -> IO a) -> CM a
withStore' (Connection -> User -> IO [RcvFileTransfer]
`getRcvFilesToReceive` User
user)
  [RcvFileTransfer]
-> (RcvFileTransfer
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RcvFileTransfer]
filesToReceive ((RcvFileTransfer
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (RcvFileTransfer
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \RcvFileTransfer
ft ->
    (ExceptT ChatError (ReaderT ChatController IO) ()
 -> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllErrors ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
      ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ChatEvent
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< User
-> RcvFileTransfer
-> Bool
-> Maybe Bool
-> Maybe String
-> ExceptT ChatError (ReaderT ChatController IO) ChatEvent
receiveFileEvt' User
user RcvFileTransfer
ft Bool
False Maybe Bool
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

restoreCalls :: CM' ()
restoreCalls :: ReaderT ChatController IO ()
restoreCalls = do
  [Call]
savedCalls <- [Call] -> Either ChatError [Call] -> [Call]
forall b a. b -> Either a b -> b
fromRight [] (Either ChatError [Call] -> [Call])
-> ReaderT ChatController IO (Either ChatError [Call])
-> ReaderT ChatController IO [Call]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT ChatError (ReaderT ChatController IO) [Call]
-> ReaderT ChatController IO (Either ChatError [Call])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((Connection -> IO [Call])
-> ExceptT ChatError (ReaderT ChatController IO) [Call]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [Call]
getCalls)
  let callsMap :: Map Int64 Call
callsMap = [(Int64, Call)] -> Map Int64 Call
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int64, Call)] -> Map Int64 Call)
-> [(Int64, Call)] -> Map Int64 Call
forall a b. (a -> b) -> a -> b
$ (Call -> (Int64, Call)) -> [Call] -> [(Int64, Call)]
forall a b. (a -> b) -> [a] -> [b]
map (\call :: Call
call@Call {Int64
contactId :: Int64
contactId :: Call -> Int64
contactId} -> (Int64
contactId, Call
call)) [Call]
savedCalls
  TMap Int64 Call
calls <- (ChatController -> TMap Int64 Call)
-> ReaderT ChatController IO (TMap Int64 Call)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Call
currentCalls
  STM () -> ReaderT ChatController IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ReaderT ChatController IO ())
-> STM () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ TMap Int64 Call -> Map Int64 Call -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TMap Int64 Call
calls Map Int64 Call
callsMap

stopChatController :: ChatController -> IO ()
stopChatController :: ChatController -> IO ()
stopChatController ChatController {AgentClient
smpAgent :: ChatController -> AgentClient
smpAgent :: AgentClient
smpAgent, agentAsync :: ChatController -> TVar (Maybe (Async (), Maybe (Async ())))
agentAsync = TVar (Maybe (Async (), Maybe (Async ())))
s, TVar (Map Int64 Handle)
sndFiles :: TVar (Map Int64 Handle)
sndFiles :: ChatController -> TVar (Map Int64 Handle)
sndFiles, TVar (Map Int64 Handle)
rcvFiles :: TVar (Map Int64 Handle)
rcvFiles :: ChatController -> TVar (Map Int64 Handle)
rcvFiles, TMap Int64 Bool
expireCIFlags :: TMap Int64 Bool
expireCIFlags :: ChatController -> TMap Int64 Bool
expireCIFlags, TMap RHKey (Int, RemoteHostSession)
remoteHostSessions :: TMap RHKey (Int, RemoteHostSession)
remoteHostSessions :: ChatController -> TMap RHKey (Int, RemoteHostSession)
remoteHostSessions, TVar (Maybe (Int, RemoteCtrlSession))
remoteCtrlSession :: TVar (Maybe (Int, RemoteCtrlSession))
remoteCtrlSession :: ChatController -> TVar (Maybe (Int, RemoteCtrlSession))
remoteCtrlSession} = do
  TMap RHKey (Int, RemoteHostSession)
-> IO (Map RHKey (Int, RemoteHostSession))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TMap RHKey (Int, RemoteHostSession)
remoteHostSessions IO (Map RHKey (Int, RemoteHostSession))
-> (Map RHKey (Int, RemoteHostSession) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Int, RemoteHostSession) -> IO ())
-> Map RHKey (Int, RemoteHostSession) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> RemoteHostSession -> IO ()
cancelRemoteHost Bool
False (RemoteHostSession -> IO ())
-> ((Int, RemoteHostSession) -> RemoteHostSession)
-> (Int, RemoteHostSession)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, RemoteHostSession) -> RemoteHostSession
forall a b. (a, b) -> b
snd)
  STM (Maybe (Int, RemoteCtrlSession))
-> IO (Maybe (Int, RemoteCtrlSession))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar (Maybe (Int, RemoteCtrlSession))
-> (Maybe (Int, RemoteCtrlSession)
    -> (Maybe (Int, RemoteCtrlSession),
        Maybe (Int, RemoteCtrlSession)))
-> STM (Maybe (Int, RemoteCtrlSession))
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar (Maybe (Int, RemoteCtrlSession))
remoteCtrlSession (,Maybe (Int, RemoteCtrlSession)
forall a. Maybe a
Nothing)) IO (Maybe (Int, RemoteCtrlSession))
-> (Maybe (Int, RemoteCtrlSession) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Int, RemoteCtrlSession) -> IO ())
-> Maybe (Int, RemoteCtrlSession) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> RemoteCtrlSession -> IO ()
cancelRemoteCtrl Bool
False (RemoteCtrlSession -> IO ())
-> ((Int, RemoteCtrlSession) -> RemoteCtrlSession)
-> (Int, RemoteCtrlSession)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, RemoteCtrlSession) -> RemoteCtrlSession
forall a b. (a, b) -> b
snd)
  AgentClient -> IO ()
disconnectAgentClient AgentClient
smpAgent
  TVar (Maybe (Async (), Maybe (Async ())))
-> IO (Maybe (Async (), Maybe (Async ())))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe (Async (), Maybe (Async ())))
s IO (Maybe (Async (), Maybe (Async ())))
-> (Maybe (Async (), Maybe (Async ())) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Async (), Maybe (Async ())) -> IO ())
-> Maybe (Async (), Maybe (Async ())) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Async ()
a1, Maybe (Async ())
a2) -> Async () -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
uninterruptibleCancel Async ()
a1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Async () -> IO ()) -> Maybe (Async ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async () -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
uninterruptibleCancel Maybe (Async ())
a2)
  TVar (Map Int64 Handle) -> IO ()
closeFiles TVar (Map Int64 Handle)
sndFiles
  TVar (Map Int64 Handle) -> IO ()
closeFiles TVar (Map Int64 Handle)
rcvFiles
  STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [Int64]
keys <- Map Int64 Bool -> [Int64]
forall k a. Map k a -> [k]
M.keys (Map Int64 Bool -> [Int64]) -> STM (Map Int64 Bool) -> STM [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMap Int64 Bool -> STM (Map Int64 Bool)
forall a. TVar a -> STM a
readTVar TMap Int64 Bool
expireCIFlags
    [Int64] -> (Int64 -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int64]
keys ((Int64 -> STM ()) -> STM ()) -> (Int64 -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Int64
k -> Int64 -> Bool -> TMap Int64 Bool -> STM ()
forall k a. Ord k => k -> a -> TMap k a -> STM ()
TM.insert Int64
k Bool
False TMap Int64 Bool
expireCIFlags
    TVar (Maybe (Async (), Maybe (Async ())))
-> Maybe (Async (), Maybe (Async ())) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe (Async (), Maybe (Async ())))
s Maybe (Async (), Maybe (Async ()))
forall a. Maybe a
Nothing
  where
    closeFiles :: TVar (Map Int64 Handle) -> IO ()
    closeFiles :: TVar (Map Int64 Handle) -> IO ()
closeFiles TVar (Map Int64 Handle)
files = do
      Map Int64 Handle
fs <- TVar (Map Int64 Handle) -> IO (Map Int64 Handle)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map Int64 Handle)
files
      (Handle -> IO ()) -> Map Int64 Handle -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Map Int64 Handle
fs
      STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map Int64 Handle) -> Map Int64 Handle -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Map Int64 Handle)
files Map Int64 Handle
forall k a. Map k a
M.empty

updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig
updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig
updateNetworkConfig NetworkConfig
cfg SimpleNetCfg {Maybe SocksProxyWithAuth
socksProxy :: Maybe SocksProxyWithAuth
socksProxy :: SimpleNetCfg -> Maybe SocksProxyWithAuth
socksProxy, SocksMode
socksMode :: SocksMode
socksMode :: SimpleNetCfg -> SocksMode
socksMode, HostMode
hostMode :: HostMode
hostMode :: SimpleNetCfg -> HostMode
hostMode, Bool
requiredHostMode :: Bool
requiredHostMode :: SimpleNetCfg -> Bool
requiredHostMode, Maybe SMPProxyMode
smpProxyMode_ :: Maybe SMPProxyMode
smpProxyMode_ :: SimpleNetCfg -> Maybe SMPProxyMode
smpProxyMode_, Maybe SMPProxyFallback
smpProxyFallback_ :: Maybe SMPProxyFallback
smpProxyFallback_ :: SimpleNetCfg -> Maybe SMPProxyFallback
smpProxyFallback_, SMPWebPortServers
smpWebPortServers :: SMPWebPortServers
smpWebPortServers :: SimpleNetCfg -> SMPWebPortServers
smpWebPortServers, Maybe Int
tcpTimeout_ :: Maybe Int
tcpTimeout_ :: SimpleNetCfg -> Maybe Int
tcpTimeout_, Bool
logTLSErrors :: Bool
logTLSErrors :: SimpleNetCfg -> Bool
logTLSErrors} =
  let cfg1 :: NetworkConfig
cfg1 = NetworkConfig
-> (SMPProxyMode -> NetworkConfig)
-> Maybe SMPProxyMode
-> NetworkConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NetworkConfig
cfg (\SMPProxyMode
smpProxyMode -> NetworkConfig
cfg {smpProxyMode}) Maybe SMPProxyMode
smpProxyMode_
      cfg2 :: NetworkConfig
cfg2 = NetworkConfig
-> (SMPProxyFallback -> NetworkConfig)
-> Maybe SMPProxyFallback
-> NetworkConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NetworkConfig
cfg1 (\SMPProxyFallback
smpProxyFallback -> NetworkConfig
cfg1 {smpProxyFallback}) Maybe SMPProxyFallback
smpProxyFallback_
      cfg3 :: NetworkConfig
cfg3 = NetworkConfig
-> (Int -> NetworkConfig) -> Maybe Int -> NetworkConfig
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NetworkConfig
cfg2 (\Int
t -> NetworkConfig
cfg2 {tcpTimeout = nt t, tcpConnectTimeout = nt ((t * 3) `div` 2)}) Maybe Int
tcpTimeout_
      nt :: Int -> NetworkTimeout
nt Int
t = NetworkTimeout {backgroundTimeout :: Int
backgroundTimeout = Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3, interactiveTimeout :: Int
interactiveTimeout = Int
t}
   in NetworkConfig
cfg3 {socksProxy, socksMode, hostMode, requiredHostMode, smpWebPortServers, logTLSErrors}

useServers :: Foldable f => RandomAgentServers -> [(Text, ServerOperator)] -> f UserOperatorServers -> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
useServers :: forall (f :: * -> *).
Foldable f =>
RandomAgentServers
-> [(Text, ServerOperator)]
-> f UserOperatorServers
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
useServers RandomAgentServers
as [(Text, ServerOperator)]
opDomains f UserOperatorServers
uss =
  let smp' :: NonEmpty (ServerCfg 'PSMP)
smp' = SProtocolType 'PSMP
-> RandomAgentServers
-> [(Text, ServerOperator)]
-> [UserServer 'PSMP]
-> NonEmpty (ServerCfg 'PSMP)
forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> RandomAgentServers
-> [(Text, ServerOperator)]
-> [UserServer p]
-> NonEmpty (ServerCfg p)
useServerCfgs SProtocolType 'PSMP
SPSMP RandomAgentServers
as [(Text, ServerOperator)]
opDomains ([UserServer 'PSMP] -> NonEmpty (ServerCfg 'PSMP))
-> [UserServer 'PSMP] -> NonEmpty (ServerCfg 'PSMP)
forall a b. (a -> b) -> a -> b
$ (UserOperatorServers -> [UserServer 'PSMP])
-> f UserOperatorServers -> [UserServer 'PSMP]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SProtocolType 'PSMP
-> UserOperatorServers -> [AServer UserOperatorServers 'PSMP]
forall u (p :: ProtocolType).
(UserServersClass u, UserProtocol p) =>
SProtocolType p -> u -> [AServer u p]
forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> UserOperatorServers -> [AServer UserOperatorServers p]
servers' SProtocolType 'PSMP
SPSMP) f UserOperatorServers
uss
      xftp' :: NonEmpty (ServerCfg 'PXFTP)
xftp' = SProtocolType 'PXFTP
-> RandomAgentServers
-> [(Text, ServerOperator)]
-> [UserServer 'PXFTP]
-> NonEmpty (ServerCfg 'PXFTP)
forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> RandomAgentServers
-> [(Text, ServerOperator)]
-> [UserServer p]
-> NonEmpty (ServerCfg p)
useServerCfgs SProtocolType 'PXFTP
SPXFTP RandomAgentServers
as [(Text, ServerOperator)]
opDomains ([UserServer 'PXFTP] -> NonEmpty (ServerCfg 'PXFTP))
-> [UserServer 'PXFTP] -> NonEmpty (ServerCfg 'PXFTP)
forall a b. (a -> b) -> a -> b
$ (UserOperatorServers -> [UserServer 'PXFTP])
-> f UserOperatorServers -> [UserServer 'PXFTP]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SProtocolType 'PXFTP
-> UserOperatorServers -> [AServer UserOperatorServers 'PXFTP]
forall u (p :: ProtocolType).
(UserServersClass u, UserProtocol p) =>
SProtocolType p -> u -> [AServer u p]
forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> UserOperatorServers -> [AServer UserOperatorServers p]
servers' SProtocolType 'PXFTP
SPXFTP) f UserOperatorServers
uss
   in (NonEmpty (ServerCfg 'PSMP)
smp', NonEmpty (ServerCfg 'PXFTP)
xftp')

execChatCommand :: Maybe RemoteHostId -> ByteString -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand :: Maybe Int64
-> ByteString -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand Maybe Int64
rh ByteString
s Int
retryNum =
  case ByteString -> Either String ChatCommand
parseChatCommand ByteString
s of
    Left String
e -> Either ChatError ChatResponse
-> CM' (Either ChatError ChatResponse)
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ChatError ChatResponse
 -> CM' (Either ChatError ChatResponse))
-> Either ChatError ChatResponse
-> CM' (Either ChatError ChatResponse)
forall a b. (a -> b) -> a -> b
$ String -> Either ChatError ChatResponse
chatCmdError String
e
    Right ChatCommand
cmd -> case Maybe Int64
rh of
      Just Int64
rhId
        | ChatCommand -> Bool
allowRemoteCommand ChatCommand
cmd -> Int64
-> ChatCommand
-> ByteString
-> Int
-> CM' (Either ChatError ChatResponse)
execRemoteCommand Int64
rhId ChatCommand
cmd ByteString
s Int
retryNum
        | Bool
otherwise -> Either ChatError ChatResponse
-> CM' (Either ChatError ChatResponse)
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ChatError ChatResponse
 -> CM' (Either ChatError ChatResponse))
-> Either ChatError ChatResponse
-> CM' (Either ChatError ChatResponse)
forall a b. (a -> b) -> a -> b
$ ChatError -> Either ChatError ChatResponse
forall a b. a -> Either a b
Left (ChatError -> Either ChatError ChatResponse)
-> ChatError -> Either ChatError ChatResponse
forall a b. (a -> b) -> a -> b
$ RHKey -> RemoteHostError -> ChatError
ChatErrorRemoteHost (Int64 -> RHKey
RHId Int64
rhId) (RemoteHostError -> ChatError) -> RemoteHostError -> ChatError
forall a b. (a -> b) -> a -> b
$ RemoteHostError
RHELocalCommand
      Maybe Int64
_ -> do
        cc :: ChatController
cc@ChatController {config :: ChatController -> ChatConfig
config = ChatConfig {ChatHooks
chatHooks :: ChatHooks
chatHooks :: ChatConfig -> ChatHooks
chatHooks}} <- ReaderT ChatController IO ChatController
forall r (m :: * -> *). MonadReader r m => m r
ask
        case ChatHooks
-> Maybe
     (ChatController
      -> ChatCommand
      -> IO (Either (Either ChatError ChatResponse) ChatCommand))
preCmdHook ChatHooks
chatHooks of
          Just ChatController
-> ChatCommand
-> IO (Either (Either ChatError ChatResponse) ChatCommand)
hook -> IO (Either (Either ChatError ChatResponse) ChatCommand)
-> ReaderT
     ChatController
     IO
     (Either (Either ChatError ChatResponse) ChatCommand)
forall a. IO a -> ReaderT ChatController IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ChatController
-> ChatCommand
-> IO (Either (Either ChatError ChatResponse) ChatCommand)
hook ChatController
cc ChatCommand
cmd) ReaderT
  ChatController
  IO
  (Either (Either ChatError ChatResponse) ChatCommand)
-> (Either (Either ChatError ChatResponse) ChatCommand
    -> CM' (Either ChatError ChatResponse))
-> CM' (Either ChatError ChatResponse)
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either ChatError ChatResponse
 -> CM' (Either ChatError ChatResponse))
-> (ChatCommand -> CM' (Either ChatError ChatResponse))
-> Either (Either ChatError ChatResponse) ChatCommand
-> CM' (Either ChatError ChatResponse)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Either ChatError ChatResponse
-> CM' (Either ChatError ChatResponse)
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatCommand -> Int -> CM' (Either ChatError ChatResponse)
`execChatCommand'` Int
retryNum)
          Maybe
  (ChatController
   -> ChatCommand
   -> IO (Either (Either ChatError ChatResponse) ChatCommand))
Nothing -> ChatCommand -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand' ChatCommand
cmd Int
retryNum

execChatCommand' :: ChatCommand -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand' :: ChatCommand -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand' ChatCommand
cmd Int
retryNum = CM ChatResponse -> CM' (Either ChatError ChatResponse)
handleCommandError (CM ChatResponse -> CM' (Either ChatError ChatResponse))
-> CM ChatResponse -> CM' (Either ChatError ChatResponse)
forall a b. (a -> b) -> a -> b
$ do
  VersionRangeChat
vr <- CM VersionRangeChat
chatVersionRange
  VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr (Int -> NetworkRequestMode
NRMInteractive' Int
retryNum) ChatCommand
cmd

execRemoteCommand :: RemoteHostId -> ChatCommand -> ByteString -> Int -> CM' (Either ChatError ChatResponse)
execRemoteCommand :: Int64
-> ChatCommand
-> ByteString
-> Int
-> CM' (Either ChatError ChatResponse)
execRemoteCommand Int64
rhId ChatCommand
cmd ByteString
s Int
retryNum = CM ChatResponse -> CM' (Either ChatError ChatResponse)
handleCommandError (CM ChatResponse -> CM' (Either ChatError ChatResponse))
-> CM ChatResponse -> CM' (Either ChatError ChatResponse)
forall a b. (a -> b) -> a -> b
$ Int64 -> CM RemoteHostClient
getRemoteHostClient Int64
rhId CM RemoteHostClient
-> (RemoteHostClient -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RemoteHostClient
rh -> Int64
-> RemoteHostClient
-> ChatCommand
-> ByteString
-> Int
-> CM ChatResponse
processRemoteCommand Int64
rhId RemoteHostClient
rh ChatCommand
cmd ByteString
s Int
retryNum

handleCommandError :: CM ChatResponse -> CM' (Either ChatError ChatResponse)
handleCommandError :: CM ChatResponse -> CM' (Either ChatError ChatResponse)
handleCommandError CM ChatResponse
a = CM ChatResponse -> CM' (Either ChatError ChatResponse)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT CM ChatResponse
a CM' (Either ChatError ChatResponse)
-> [Handler
      (ReaderT ChatController IO) (Either ChatError ChatResponse)]
-> CM' (Either ChatError ChatResponse)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`E.catches` [Handler
   (ReaderT ChatController IO) (Either ChatError ChatResponse)]
ioErrors
  where
    ioErrors :: [Handler
   (ReaderT ChatController IO) (Either ChatError ChatResponse)]
ioErrors =
      [ (ExitCode -> CM' (Either ChatError ChatResponse))
-> Handler
     (ReaderT ChatController IO) (Either ChatError ChatResponse)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
E.Handler ((ExitCode -> CM' (Either ChatError ChatResponse))
 -> Handler
      (ReaderT ChatController IO) (Either ChatError ChatResponse))
-> (ExitCode -> CM' (Either ChatError ChatResponse))
-> Handler
     (ReaderT ChatController IO) (Either ChatError ChatResponse)
forall a b. (a -> b) -> a -> b
$ \(ExitCode
e :: ExitCode) -> ExitCode -> CM' (Either ChatError ChatResponse)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO ExitCode
e,
        (SomeException -> CM' (Either ChatError ChatResponse))
-> Handler
     (ReaderT ChatController IO) (Either ChatError ChatResponse)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
E.Handler ((SomeException -> CM' (Either ChatError ChatResponse))
 -> Handler
      (ReaderT ChatController IO) (Either ChatError ChatResponse))
-> (SomeException -> CM' (Either ChatError ChatResponse))
-> Handler
     (ReaderT ChatController IO) (Either ChatError ChatResponse)
forall a b. (a -> b) -> a -> b
$ Either ChatError ChatResponse
-> CM' (Either ChatError ChatResponse)
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ChatError ChatResponse
 -> CM' (Either ChatError ChatResponse))
-> (SomeException -> Either ChatError ChatResponse)
-> SomeException
-> CM' (Either ChatError ChatResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatError -> Either ChatError ChatResponse
forall a b. a -> Either a b
Left (ChatError -> Either ChatError ChatResponse)
-> (SomeException -> ChatError)
-> SomeException
-> Either ChatError ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ChatError
forall e. AnyError e => SomeException -> e
fromSomeException
      ]

parseChatCommand :: ByteString -> Either String ChatCommand
parseChatCommand :: ByteString -> Either String ChatCommand
parseChatCommand = Parser ByteString ChatCommand
-> ByteString -> Either String ChatCommand
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser ByteString ChatCommand
chatCommandP (ByteString -> Either String ChatCommand)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
B.dropWhileEnd Char -> Bool
isSpace

-- | Chat API commands interpreted in context of a local zone
processChatCommand :: VersionRangeChat -> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand :: VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm = \case
  ChatCommand
ShowActiveUser -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> (User -> ChatResponse) -> User -> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> ChatResponse
CRActiveUser
  CreateActiveUser NewUser {Maybe Profile
profile :: Maybe Profile
profile :: NewUser -> Maybe Profile
profile, Bool
pastTimestamp :: Bool
pastTimestamp :: NewUser -> Bool
pastTimestamp} -> do
    Maybe Profile
-> (Profile -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Profile
profile ((Profile -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Profile -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Profile {Text
displayName :: Text
displayName :: Profile -> Text
displayName} -> Text -> ExceptT ChatError (ReaderT ChatController IO) ()
checkValidName Text
displayName
    p :: Profile
p@Profile {Text
displayName :: Profile -> Text
displayName :: Text
displayName} <- IO Profile -> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Profile
 -> ExceptT ChatError (ReaderT ChatController IO) Profile)
-> IO Profile
-> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a b. (a -> b) -> a -> b
$ IO Profile
-> (Profile -> IO Profile) -> Maybe Profile -> IO Profile
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Profile
generateRandomProfile Profile -> IO Profile
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Profile
profile
    TVar (Maybe User)
u <- (ChatController -> TVar (Maybe User))
-> ExceptT
     ChatError (ReaderT ChatController IO) (TVar (Maybe User))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe User)
currentUser
    [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [User]
getUsers
    [User]
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [User]
users ((User -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \User {localDisplayName :: User -> Text
localDisplayName = Text
n, Bool
activeUser :: User -> Bool
activeUser :: Bool
activeUser, Maybe UserPwdHash
viewPwdHash :: Maybe UserPwdHash
viewPwdHash :: User -> Maybe UserPwdHash
viewPwdHash} ->
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
displayName) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatErrorType
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
        if Bool
activeUser Bool -> Bool -> Bool
|| Maybe UserPwdHash -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UserPwdHash
viewPwdHash then Text -> ChatErrorType
CEUserExists Text
displayName else CEInvalidDisplayName {Text
displayName :: Text
displayName :: Text
displayName, validName :: Text
validName = Text
""}
    ([UpdatedUserOperatorServers]
uss, (NonEmpty (ServerCfg 'PSMP)
smp', NonEmpty (ServerCfg 'PXFTP)
xftp')) <- Maybe User
-> CM
     ([UpdatedUserOperatorServers],
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
chooseServers (Maybe User
 -> CM
      ([UpdatedUserOperatorServers],
       (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))))
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe User)
-> CM
     ([UpdatedUserOperatorServers],
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar (Maybe User)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe User)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Maybe User)
u
    Int64
auId <- (AgentClient -> ExceptT AgentErrorType IO Int64) -> CM Int64
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO Int64) -> CM Int64)
-> (AgentClient -> ExceptT AgentErrorType IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NonEmpty (ServerCfg 'PSMP)
-> NonEmpty (ServerCfg 'PXFTP)
-> ExceptT AgentErrorType IO Int64
createUser AgentClient
a NonEmpty (ServerCfg 'PSMP)
smp' NonEmpty (ServerCfg 'PXFTP)
xftp'
    UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime
 -> ExceptT ChatError (ReaderT ChatController IO) UTCTime)
-> IO UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime
getCurrentTime IO UTCTime -> (UTCTime -> IO UTCTime) -> IO UTCTime
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= if Bool
pastTimestamp then UTCTime -> IO UTCTime
coupleDaysAgo else UTCTime -> IO UTCTime
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    User
user <- (Connection -> ExceptT StoreError IO User) -> CM User
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO User) -> CM User)
-> (Connection -> ExceptT StoreError IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      User
user <- Connection
-> AgentUserId
-> Profile
-> Bool
-> UTCTime
-> ExceptT StoreError IO User
createUserRecordAt Connection
db (Int64 -> AgentUserId
AgentUserId Int64
auId) Profile
p Bool
True UTCTime
ts
      (UpdatedUserOperatorServers
 -> ExceptT StoreError IO UserOperatorServers)
-> [UpdatedUserOperatorServers] -> ExceptT StoreError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Connection
-> User
-> UTCTime
-> UpdatedUserOperatorServers
-> ExceptT StoreError IO UserOperatorServers
setUserServers Connection
db User
user UTCTime
ts) [UpdatedUserOperatorServers]
uss
      Connection -> User -> ExceptT StoreError IO ()
createPresetContactCards Connection
db User
user ExceptT StoreError IO ()
-> (StoreError -> ExceptT StoreError IO ())
-> ExceptT StoreError IO ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \StoreError
_ -> () -> ExceptT StoreError IO ()
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Connection -> User -> ExceptT StoreError IO ()
createNoteFolder Connection
db User
user
      User -> ExceptT StoreError IO User
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure User
user
    STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Maybe User -> STM ())
-> Maybe User
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Maybe User) -> Maybe User -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe User)
u (Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Maybe User
forall a. a -> Maybe a
Just User
user
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> ChatResponse
CRActiveUser User
user
    where
      createPresetContactCards :: DB.Connection -> User -> ExceptT StoreError IO ()
      createPresetContactCards :: Connection -> User -> ExceptT StoreError IO ()
createPresetContactCards Connection
db User
user = do
        Connection -> User -> Profile -> ExceptT StoreError IO ()
createContact Connection
db User
user Profile
simplexStatusContactProfile
        Connection -> User -> Profile -> ExceptT StoreError IO ()
createContact Connection
db User
user Profile
simplexTeamContactProfile
      chooseServers :: Maybe User -> CM ([UpdatedUserOperatorServers], (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
      chooseServers :: Maybe User
-> CM
     ([UpdatedUserOperatorServers],
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
chooseServers Maybe User
user_ = do
        RandomAgentServers
as <- (ChatController -> RandomAgentServers)
-> ExceptT ChatError (ReaderT ChatController IO) RandomAgentServers
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> RandomAgentServers
randomAgentServers
        (User
 -> ExceptT
      ChatError (ReaderT ChatController IO) [UserOperatorServers])
-> Maybe User
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe [UserOperatorServers])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM ((Connection
 -> ExceptT
      StoreError
      IO
      ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
-> CM
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError
       IO
       ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
 -> CM
      ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
-> (User
    -> Connection
    -> ExceptT
         StoreError
         IO
         ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
-> User
-> CM
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection
 -> User
 -> ExceptT
      StoreError
      IO
      ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
-> User
-> Connection
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Connection
-> User
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
getUserServers (User
 -> CM
      ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
-> (([Maybe ServerOperator], [UserServer 'PSMP],
     [UserServer 'PXFTP])
    -> ExceptT
         ChatError (ReaderT ChatController IO) [UserOperatorServers])
-> User
-> ExceptT
     ChatError (ReaderT ChatController IO) [UserOperatorServers]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IO [UserOperatorServers]
-> ExceptT
     ChatError (ReaderT ChatController IO) [UserOperatorServers]
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UserOperatorServers]
 -> ExceptT
      ChatError (ReaderT ChatController IO) [UserOperatorServers])
-> (([Maybe ServerOperator], [UserServer 'PSMP],
     [UserServer 'PXFTP])
    -> IO [UserOperatorServers])
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
-> ExceptT
     ChatError (ReaderT ChatController IO) [UserOperatorServers]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> IO [UserOperatorServers]
groupByOperator) Maybe User
user_ ExceptT
  ChatError (ReaderT ChatController IO) (Maybe [UserOperatorServers])
-> (Maybe [UserOperatorServers]
    -> CM
         ([UpdatedUserOperatorServers],
          (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))))
-> CM
     ([UpdatedUserOperatorServers],
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just [UserOperatorServers]
uss -> do
            let opDomains :: [(Text, ServerOperator)]
opDomains = [ServerOperator] -> [(Text, ServerOperator)]
forall (s :: DBStored).
[ServerOperator' s] -> [(Text, ServerOperator' s)]
operatorDomains ([ServerOperator] -> [(Text, ServerOperator)])
-> [ServerOperator] -> [(Text, ServerOperator)]
forall a b. (a -> b) -> a -> b
$ (UserOperatorServers -> Maybe ServerOperator)
-> [UserOperatorServers] -> [ServerOperator]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UserOperatorServers -> Maybe ServerOperator
forall u. UserServersClass u => u -> Maybe ServerOperator
operator' [UserOperatorServers]
uss
                uss' :: [UpdatedUserOperatorServers]
uss' = (UserOperatorServers -> UpdatedUserOperatorServers)
-> [UserOperatorServers] -> [UpdatedUserOperatorServers]
forall a b. (a -> b) -> [a] -> [b]
map UserOperatorServers -> UpdatedUserOperatorServers
copyServers [UserOperatorServers]
uss
            ([UpdatedUserOperatorServers],
 (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
-> CM
     ([UpdatedUserOperatorServers],
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([UpdatedUserOperatorServers],
  (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
 -> CM
      ([UpdatedUserOperatorServers],
       (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))))
-> ([UpdatedUserOperatorServers],
    (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
-> CM
     ([UpdatedUserOperatorServers],
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a b. (a -> b) -> a -> b
$ ([UpdatedUserOperatorServers]
uss',) ((NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
 -> ([UpdatedUserOperatorServers],
     (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))))
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
-> ([UpdatedUserOperatorServers],
    (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a b. (a -> b) -> a -> b
$ RandomAgentServers
-> [(Text, ServerOperator)]
-> [UserOperatorServers]
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
forall (f :: * -> *).
Foldable f =>
RandomAgentServers
-> [(Text, ServerOperator)]
-> f UserOperatorServers
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
useServers RandomAgentServers
as [(Text, ServerOperator)]
opDomains [UserOperatorServers]
uss
          Maybe [UserOperatorServers]
Nothing -> do
            NonEmpty PresetOperator
ps <- (ChatController -> NonEmpty PresetOperator)
-> ExceptT
     ChatError (ReaderT ChatController IO) (NonEmpty PresetOperator)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> NonEmpty PresetOperator
randomPresetServers
            [UpdatedUserOperatorServers]
uss <- [(Maybe PresetOperator, Maybe ServerOperator)]
-> [UpdatedUserOperatorServers]
presetUserServers ([(Maybe PresetOperator, Maybe ServerOperator)]
 -> [UpdatedUserOperatorServers])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [(Maybe PresetOperator, Maybe ServerOperator)]
-> ExceptT
     ChatError (ReaderT ChatController IO) [UpdatedUserOperatorServers]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [(Maybe PresetOperator, Maybe ServerOperator)])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [(Maybe PresetOperator, Maybe ServerOperator)]
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> NonEmpty PresetOperator
-> Bool
-> IO [(Maybe PresetOperator, Maybe ServerOperator)]
getUpdateServerOperators Connection
db NonEmpty PresetOperator
ps Bool
True)
            let RandomAgentServers {smpServers :: RandomAgentServers -> NonEmpty (ServerCfg 'PSMP)
smpServers = NonEmpty (ServerCfg 'PSMP)
smp', xftpServers :: RandomAgentServers -> NonEmpty (ServerCfg 'PXFTP)
xftpServers = NonEmpty (ServerCfg 'PXFTP)
xftp'} = RandomAgentServers
as
            ([UpdatedUserOperatorServers],
 (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
-> CM
     ([UpdatedUserOperatorServers],
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([UpdatedUserOperatorServers]
uss, (NonEmpty (ServerCfg 'PSMP)
smp', NonEmpty (ServerCfg 'PXFTP)
xftp'))
      copyServers :: UserOperatorServers -> UpdatedUserOperatorServers
      copyServers :: UserOperatorServers -> UpdatedUserOperatorServers
copyServers UserOperatorServers {Maybe ServerOperator
operator :: Maybe ServerOperator
operator :: UserOperatorServers -> Maybe ServerOperator
operator, [UserServer 'PSMP]
smpServers :: [UserServer 'PSMP]
smpServers :: UserOperatorServers -> [UserServer 'PSMP]
smpServers, [UserServer 'PXFTP]
xftpServers :: [UserServer 'PXFTP]
xftpServers :: UserOperatorServers -> [UserServer 'PXFTP]
xftpServers} =
        let new :: UserServer' s p -> AUserServer p
new UserServer' s p
srv = SDBStored 'DBNew -> UserServer' 'DBNew p -> AUserServer p
forall (p :: ProtocolType) (s :: DBStored).
SDBStored s -> UserServer' s p -> AUserServer p
AUS SDBStored 'DBNew
SDBNew UserServer' s p
srv {serverId = DBNewEntity}
         in UpdatedUserOperatorServers {Maybe ServerOperator
operator :: Maybe ServerOperator
operator :: Maybe ServerOperator
operator, smpServers :: [AUserServer 'PSMP]
smpServers = (UserServer 'PSMP -> AUserServer 'PSMP)
-> [UserServer 'PSMP] -> [AUserServer 'PSMP]
forall a b. (a -> b) -> [a] -> [b]
map UserServer 'PSMP -> AUserServer 'PSMP
forall {s :: DBStored} {p :: ProtocolType}.
UserServer' s p -> AUserServer p
new [UserServer 'PSMP]
smpServers, xftpServers :: [AUserServer 'PXFTP]
xftpServers = (UserServer 'PXFTP -> AUserServer 'PXFTP)
-> [UserServer 'PXFTP] -> [AUserServer 'PXFTP]
forall a b. (a -> b) -> [a] -> [b]
map UserServer 'PXFTP -> AUserServer 'PXFTP
forall {s :: DBStored} {p :: ProtocolType}.
UserServer' s p -> AUserServer p
new [UserServer 'PXFTP]
xftpServers}
      coupleDaysAgo :: UTCTime -> IO UTCTime
coupleDaysAgo UTCTime
t = (NominalDiffTime -> UTCTime -> UTCTime
`addUTCTime` UTCTime
t) (NominalDiffTime -> UTCTime)
-> (Integer -> NominalDiffTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> NominalDiffTime)
-> (Integer -> Integer) -> Integer -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
day)) (Integer -> UTCTime) -> IO Integer -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> IO Integer
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Integer
0, Integer
day)
      day :: Integer
day = Integer
86400
  ChatCommand
ListUsers -> [UserInfo] -> ChatResponse
CRUsersList ([UserInfo] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [UserInfo]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [UserInfo])
-> ExceptT ChatError (ReaderT ChatController IO) [UserInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [UserInfo]
getUsersInfo
  APISetActiveUser Int64
userId' Maybe UserPwd
viewPwd_ -> do
    ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (ReaderT ChatController IO Bool
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO Bool
chatStarted) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEChatNotStarted
    Maybe User
user_ <- (ChatController -> TVar (Maybe User))
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe User)
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar (Maybe User)
currentUser
    User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
    Maybe User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword_ Maybe User
user_ User
user' Maybe UserPwd
viewPwd_
    User
user'' <- (Connection -> IO User) -> CM User
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO User
`setActiveUser` User
user')
    (ChatController -> TVar (Maybe User))
-> Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar (Maybe User)
currentUser (Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Maybe User
forall a. a -> Maybe a
Just User
user''
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> ChatResponse
CRActiveUser User
user''
  SetActiveUser Text
uName Maybe UserPwd
viewPwd_ -> do
    CM Int64
-> ExceptT
     ChatError (ReaderT ChatController IO) (Either ChatError Int64)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors ((Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> Text -> ExceptT StoreError IO Int64
`getUserIdByName` Text
uName)) ExceptT
  ChatError (ReaderT ChatController IO) (Either ChatError Int64)
-> (Either ChatError Int64 -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left ChatError
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEUserUnknown
      Right Int64
userId -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe UserPwd -> ChatCommand
APISetActiveUser Int64
userId Maybe UserPwd
viewPwd_
  SetAllContactReceipts Bool
onOff -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> Bool -> IO ()
`updateAllContactReceipts` Bool
onOff) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  APISetUserContactReceipts Int64
userId' UserMsgReceiptSettings
settings -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
    User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword User
user User
user' Maybe UserPwd
forall a. Maybe a
Nothing
    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserContactReceipts Connection
db User
user' UserMsgReceiptSettings
settings
    User -> CM ChatResponse
ok User
user
  SetUserContactReceipts UserMsgReceiptSettings
settings -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: Int64
userId :: User -> Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> UserMsgReceiptSettings -> ChatCommand
APISetUserContactReceipts Int64
userId UserMsgReceiptSettings
settings
  APISetUserGroupReceipts Int64
userId' UserMsgReceiptSettings
settings -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
    User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword User
user User
user' Maybe UserPwd
forall a. Maybe a
Nothing
    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserGroupReceipts Connection
db User
user' UserMsgReceiptSettings
settings
    User -> CM ChatResponse
ok User
user
  SetUserGroupReceipts UserMsgReceiptSettings
settings -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> UserMsgReceiptSettings -> ChatCommand
APISetUserGroupReceipts Int64
userId UserMsgReceiptSettings
settings
  APISetUserAutoAcceptMemberContacts Int64
userId' Bool
onOff -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
    User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword User
user User
user' Maybe UserPwd
forall a. Maybe a
Nothing
    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Bool -> IO ()
updateUserAutoAcceptMemberContacts Connection
db User
user' Bool
onOff
    User -> CM ChatResponse
ok User
user
  SetUserAutoAcceptMemberContacts Bool
onOff -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> ChatCommand
APISetUserAutoAcceptMemberContacts Int64
userId Bool
onOff
  APIHideUser Int64
userId' (UserPwd Text
viewPwd) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
    case User -> Maybe UserPwdHash
viewPwdHash User
user' of
      Just UserPwdHash
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatErrorType
CEUserAlreadyHidden Int64
userId'
      Maybe UserPwdHash
_ -> do
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
viewPwd) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatErrorType
CEEmptyUserPassword Int64
userId'
        [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [User]
getUsers
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([User] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((User -> Bool) -> [User] -> [User]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe UserPwdHash -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe UserPwdHash -> Bool)
-> (User -> Maybe UserPwdHash) -> User -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Maybe UserPwdHash
viewPwdHash) [User]
users) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatErrorType
CECantHideLastUser Int64
userId'
        Maybe UserPwdHash
viewPwdHash' <- ExceptT ChatError (ReaderT ChatController IO) (Maybe UserPwdHash)
hashPassword
        User -> User -> CM ChatResponse
setUserPrivacy User
user User
user' {viewPwdHash = viewPwdHash', showNtfs = False}
        where
          hashPassword :: ExceptT ChatError (ReaderT ChatController IO) (Maybe UserPwdHash)
hashPassword = do
            ByteString
salt <- Int -> CM ByteString
drgRandomBytes Int
16
            let hash :: B64UrlByteString
hash = ByteString -> B64UrlByteString
B64UrlByteString (ByteString -> B64UrlByteString) -> ByteString -> B64UrlByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
C.sha512Hash (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
viewPwd ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
salt
            Maybe UserPwdHash
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe UserPwdHash)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe UserPwdHash
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe UserPwdHash))
-> Maybe UserPwdHash
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe UserPwdHash)
forall a b. (a -> b) -> a -> b
$ UserPwdHash -> Maybe UserPwdHash
forall a. a -> Maybe a
Just UserPwdHash {B64UrlByteString
hash :: B64UrlByteString
hash :: B64UrlByteString
hash, salt :: B64UrlByteString
salt = ByteString -> B64UrlByteString
B64UrlByteString ByteString
salt}
  APIUnhideUser Int64
userId' viewPwd :: UserPwd
viewPwd@(UserPwd Text
pwd) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
    case User -> Maybe UserPwdHash
viewPwdHash User
user' of
      Maybe UserPwdHash
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatErrorType
CEUserNotHidden Int64
userId'
      Maybe UserPwdHash
_ -> do
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
pwd) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatErrorType
CEEmptyUserPassword Int64
userId'
        User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword User
user User
user' (Maybe UserPwd -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ UserPwd -> Maybe UserPwd
forall a. a -> Maybe a
Just UserPwd
viewPwd
        User -> User -> CM ChatResponse
setUserPrivacy User
user User
user' {viewPwdHash = Nothing, showNtfs = True}
  APIMuteUser Int64
userId' -> Int64 -> Bool -> CM ChatResponse
setUserNotifications Int64
userId' Bool
False
  APIUnmuteUser Int64
userId' -> Int64 -> Bool -> CM ChatResponse
setUserNotifications Int64
userId' Bool
True
  HideUser UserPwd
viewPwd -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> UserPwd -> ChatCommand
APIHideUser Int64
userId UserPwd
viewPwd
  UnhideUser UserPwd
viewPwd -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> UserPwd -> ChatCommand
APIUnhideUser Int64
userId UserPwd
viewPwd
  ChatCommand
MuteUser -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIMuteUser Int64
userId
  ChatCommand
UnmuteUser -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIUnmuteUser Int64
userId
  APIDeleteUser Int64
userId' Bool
delSMPQueues Maybe UserPwd
viewPwd_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
    User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword User
user User
user' Maybe UserPwd
viewPwd_
    User -> ExceptT ChatError (ReaderT ChatController IO) ()
checkDeleteChatUser User
user'
    Text -> CM ChatResponse -> CM ChatResponse
forall a. Text -> CM a -> CM a
withChatLock Text
"deleteUser" (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Bool -> CM ChatResponse
deleteChatUser User
user' Bool
delSMPQueues
  DeleteUser Text
uName Bool
delSMPQueues Maybe UserPwd
viewPwd_ -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withUserName Text
uName ((Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
userId -> Int64 -> Bool -> Maybe UserPwd -> ChatCommand
APIDeleteUser Int64
userId Bool
delSMPQueues Maybe UserPwd
viewPwd_
  StartChat {Bool
mainApp :: Bool
mainApp :: ChatCommand -> Bool
mainApp, Bool
enableSndFiles :: Bool
enableSndFiles :: ChatCommand -> Bool
enableSndFiles} -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ ->
    (ChatController -> TVar (Maybe (Async (), Maybe (Async ()))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (TVar (Maybe (Async (), Maybe (Async ()))))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe (Async (), Maybe (Async ())))
agentAsync ExceptT
  ChatError
  (ReaderT ChatController IO)
  (TVar (Maybe (Async (), Maybe (Async ()))))
-> (TVar (Maybe (Async (), Maybe (Async ())))
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe (Async (), Maybe (Async ()))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (Async (), Maybe (Async ())))
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar (Maybe (Async (), Maybe (Async ())))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (Async (), Maybe (Async ())))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Maybe (Async (), Maybe (Async ())))
-> (Maybe (Async (), Maybe (Async ())) -> CM ChatResponse)
-> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just (Async (), Maybe (Async ()))
_ -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatResponse
CRChatRunning
      Maybe (Async (), Maybe (Async ()))
_ -> CM ChatResponse -> CM ChatResponse
checkStoreNotChanged (CM ChatResponse -> CM ChatResponse)
-> (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse
-> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> CM' (Async ())
startChatController Bool
mainApp Bool
enableSndFiles CM' (Async ())
-> ChatResponse -> ReaderT ChatController IO ChatResponse
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatResponse
CRChatStarted
  ChatCommand
CheckChatRunning -> ChatResponse
-> ((Async (), Maybe (Async ())) -> ChatResponse)
-> Maybe (Async (), Maybe (Async ()))
-> ChatResponse
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ChatResponse
CRChatStopped (ChatResponse -> (Async (), Maybe (Async ())) -> ChatResponse
forall a b. a -> b -> a
const ChatResponse
CRChatRunning) (Maybe (Async (), Maybe (Async ())) -> ChatResponse)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (Async (), Maybe (Async ())))
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatController -> TVar (Maybe (Async (), Maybe (Async ()))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (Async (), Maybe (Async ())))
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar (Maybe (Async (), Maybe (Async ())))
agentAsync
  ChatCommand
APIStopChat -> do
    ExceptT ChatError (ReaderT ChatController IO) ChatController
forall r (m :: * -> *). MonadReader r m => m r
ask ExceptT ChatError (ReaderT ChatController IO) ChatController
-> (ChatController
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatController -> IO ())
-> ChatController
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> IO ()
stopChatController
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatResponse
CRChatStopped
  APIActivateChat Bool
restoreChat -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> do
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
restoreChat ReaderT ChatController IO ()
restoreCalls
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO ()
foregroundAgent
    (ChatController -> TVar Bool)
-> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar Bool
chatActivated Bool
True
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
restoreChat (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
      [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [User]
getUsers
      ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
        ReaderT ChatController IO ThreadId -> ReaderT ChatController IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT ChatController IO ThreadId
 -> ReaderT ChatController IO ())
-> (ReaderT ChatController IO ()
    -> ReaderT ChatController IO ThreadId)
-> ReaderT ChatController IO ()
-> ReaderT ChatController IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ChatController IO () -> ReaderT ChatController IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> [User] -> ReaderT ChatController IO ()
subscribeUsers Bool
True [User]
users
        ReaderT ChatController IO ThreadId -> ReaderT ChatController IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT ChatController IO ThreadId
 -> ReaderT ChatController IO ())
-> (ReaderT ChatController IO ()
    -> ReaderT ChatController IO ThreadId)
-> ReaderT ChatController IO ()
-> ReaderT ChatController IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ChatController IO () -> ReaderT ChatController IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ [User] -> ReaderT ChatController IO ()
startFilesToReceive [User]
users
        Bool -> ReaderT ChatController IO ()
setAllExpireCIFlags Bool
True
    CM ChatResponse
ok_
  APISuspendChat Int
t -> do
    (ChatController -> TVar Bool)
-> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar Bool
chatActivated Bool
False
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Bool -> ReaderT ChatController IO ()
setAllExpireCIFlags Bool
False
    ExceptT ChatError (ReaderT ChatController IO) ()
stopRemoteCtrl
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' (AgentClient -> Int -> IO ()
`suspendAgent` Int
t)
    CM ChatResponse
ok_
  ShowConnectionsDiff Bool
showIds -> do
    [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [User]
getUsers
    let aUserIds :: [Int64]
aUserIds = (User -> Int64) -> [User] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map User -> Int64
aUserId [User]
users
    [ByteString]
connIds <- [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ByteString]] -> [ByteString])
-> ExceptT ChatError (ReaderT ChatController IO) [[ByteString]]
-> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [User]
-> (User
    -> ExceptT ChatError (ReaderT ChatController IO) [ByteString])
-> ExceptT ChatError (ReaderT ChatController IO) [[ByteString]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [User]
users User -> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
getConnsToSub
    (DatabaseDiff Int64
userDiff, DatabaseDiff ByteString
connDiff) <- (AgentClient
 -> ExceptT
      AgentErrorType IO (DatabaseDiff Int64, DatabaseDiff ByteString))
-> CM (DatabaseDiff Int64, DatabaseDiff ByteString)
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> [Int64]
-> [ByteString]
-> ExceptT
     AgentErrorType IO (DatabaseDiff Int64, DatabaseDiff ByteString)
compareConnections AgentClient
a [Int64]
aUserIds [ByteString]
connIds)
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Bool
-> DatabaseDiff AgentUserId
-> DatabaseDiff AgentConnId
-> ChatResponse
CRConnectionsDiff Bool
showIds (Int64 -> AgentUserId
AgentUserId (Int64 -> AgentUserId)
-> DatabaseDiff Int64 -> DatabaseDiff AgentUserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseDiff Int64
userDiff) (ByteString -> AgentConnId
AgentConnId (ByteString -> AgentConnId)
-> DatabaseDiff ByteString -> DatabaseDiff AgentConnId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseDiff ByteString
connDiff)
  ChatCommand
ResubscribeAllConnections -> (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withStore' Connection -> IO [User]
getUsers ExceptT ChatError (ReaderT ChatController IO) [User]
-> ([User] -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ([User] -> ReaderT ChatController IO ())
-> [User]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [User] -> ReaderT ChatController IO ()
subscribeUsers Bool
False ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  -- has to be called before StartChat
  SetTempFolder String
tf -> do
    Bool -> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
tf
    (ChatController -> TVar (Maybe String))
-> ExceptT
     ChatError (ReaderT ChatController IO) (TVar (Maybe String))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe String)
tempDirectory ExceptT ChatError (ReaderT ChatController IO) (TVar (Maybe String))
-> (TVar (Maybe String)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (TVar (Maybe String) -> STM ())
-> TVar (Maybe String)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar (Maybe String) -> Maybe String -> STM ()
forall a. TVar a -> a -> STM ()
`writeTVar` String -> Maybe String
forall a. a -> Maybe a
Just String
tf)
    CM ChatResponse
ok_
  SetFilesFolder String
ff -> do
    Bool -> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
ff
    (ChatController -> TVar (Maybe String))
-> ExceptT
     ChatError (ReaderT ChatController IO) (TVar (Maybe String))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe String)
filesFolder ExceptT ChatError (ReaderT ChatController IO) (TVar (Maybe String))
-> (TVar (Maybe String)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (TVar (Maybe String) -> STM ())
-> TVar (Maybe String)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar (Maybe String) -> Maybe String -> STM ()
forall a. TVar a -> a -> STM ()
`writeTVar` String -> Maybe String
forall a. a -> Maybe a
Just String
ff)
    CM ChatResponse
ok_
  SetRemoteHostsFolder String
rf -> do
    Bool -> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
rf
    (ChatController -> TVar (Maybe String))
-> Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar (Maybe String)
remoteHostsFolder (Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
rf
    CM ChatResponse
ok_
  -- has to be called before StartChat
  APISetAppFilePaths AppFilePathsConfig
cfg -> do
    (ChatController -> TVar (Maybe String))
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
setFolder ChatController -> TVar (Maybe String)
filesFolder (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ AppFilePathsConfig -> String
appFilesFolder AppFilePathsConfig
cfg
    (ChatController -> TVar (Maybe String))
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
setFolder ChatController -> TVar (Maybe String)
tempDirectory (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ AppFilePathsConfig -> String
appTempFolder AppFilePathsConfig
cfg
    (ChatController -> TVar (Maybe String))
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
setFolder ChatController -> TVar (Maybe String)
assetsDirectory (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ AppFilePathsConfig -> String
appAssetsFolder AppFilePathsConfig
cfg
    (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ChatController -> TVar (Maybe String))
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
setFolder ChatController -> TVar (Maybe String)
remoteHostsFolder) (Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ AppFilePathsConfig -> Maybe String
appRemoteHostsFolder AppFilePathsConfig
cfg
    CM ChatResponse
ok_
    where
      setFolder :: (ChatController -> TVar (Maybe String))
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
setFolder ChatController -> TVar (Maybe String)
sel String
f = do
        Bool -> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
createDirectoryIfMissing Bool
True String
f
        (ChatController -> TVar (Maybe String))
-> Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar (Maybe String)
sel (Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
f
  APISetEncryptLocalFiles Bool
on -> (ChatController -> TVar Bool)
-> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar Bool
encryptLocalFiles Bool
on ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  SetContactMergeEnabled Bool
onOff -> (ChatController -> TVar Bool)
-> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar Bool
contactMergeEnabled Bool
onOff ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
#if !defined(dbPostgres)
  APIExportArchive ArchiveConfig
cfg -> CM ChatResponse -> CM ChatResponse
checkChatStopped (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ [ArchiveError] -> ChatResponse
CRArchiveExported ([ArchiveError] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [ArchiveError]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ChatController IO [ArchiveError]
-> ExceptT ChatError (ReaderT ChatController IO) [ArchiveError]
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ArchiveConfig -> ReaderT ChatController IO [ArchiveError]
exportArchive ArchiveConfig
cfg)
  ChatCommand
ExportArchive -> do
    UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    let filePath :: String
filePath = String
"simplex-chat." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%H%M%SZ" UTCTime
ts String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".zip"
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ArchiveConfig -> ChatCommand
APIExportArchive (ArchiveConfig -> ChatCommand) -> ArchiveConfig -> ChatCommand
forall a b. (a -> b) -> a -> b
$ String -> Maybe Bool -> Maybe String -> ArchiveConfig
ArchiveConfig String
filePath Maybe Bool
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  APIImportArchive ArchiveConfig
cfg -> CM ChatResponse -> CM ChatResponse
checkChatStopped (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    [ArchiveError]
fileErrs <- ReaderT ChatController IO [ArchiveError]
-> ExceptT ChatError (ReaderT ChatController IO) [ArchiveError]
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO [ArchiveError]
 -> ExceptT ChatError (ReaderT ChatController IO) [ArchiveError])
-> ReaderT ChatController IO [ArchiveError]
-> ExceptT ChatError (ReaderT ChatController IO) [ArchiveError]
forall a b. (a -> b) -> a -> b
$ ArchiveConfig -> ReaderT ChatController IO [ArchiveError]
importArchive ArchiveConfig
cfg
    ExceptT ChatError (ReaderT ChatController IO) ()
setStoreChanged
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ [ArchiveError] -> ChatResponse
CRArchiveImported [ArchiveError]
fileErrs
  ChatCommand
APIDeleteStorage -> ExceptT ChatError (ReaderT ChatController IO) () -> CM ChatResponse
withStoreChanged ExceptT ChatError (ReaderT ChatController IO) ()
deleteStorage
  APIStorageEncryption DBEncryptionConfig
cfg -> ExceptT ChatError (ReaderT ChatController IO) () -> CM ChatResponse
withStoreChanged (ExceptT ChatError (ReaderT ChatController IO) ()
 -> CM ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ DBEncryptionConfig
-> ExceptT ChatError (ReaderT ChatController IO) ()
sqlCipherExport DBEncryptionConfig
cfg
  TestStorageEncryption DBEncryptionKey
key -> DBEncryptionKey -> ExceptT ChatError (ReaderT ChatController IO) ()
sqlCipherTestKey DBEncryptionKey
key ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ChatCommand
SlowSQLQueries -> do
    ChatController {DBStore
chatStore :: DBStore
chatStore :: ChatController -> DBStore
chatStore, AgentClient
smpAgent :: ChatController -> AgentClient
smpAgent :: AgentClient
smpAgent} <- ExceptT ChatError (ReaderT ChatController IO) ChatController
forall r (m :: * -> *). MonadReader r m => m r
ask
    [SlowSQLQuery]
chatQueries <- DBStore
-> ExceptT ChatError (ReaderT ChatController IO) [SlowSQLQuery]
forall {m :: * -> *}. MonadIO m => DBStore -> m [SlowSQLQuery]
slowQueries DBStore
chatStore
    [SlowSQLQuery]
agentQueries <- DBStore
-> ExceptT ChatError (ReaderT ChatController IO) [SlowSQLQuery]
forall {m :: * -> *}. MonadIO m => DBStore -> m [SlowSQLQuery]
slowQueries (DBStore
 -> ExceptT ChatError (ReaderT ChatController IO) [SlowSQLQuery])
-> DBStore
-> ExceptT ChatError (ReaderT ChatController IO) [SlowSQLQuery]
forall a b. (a -> b) -> a -> b
$ AgentClient -> DBStore
agentClientStore AgentClient
smpAgent
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRSlowSQLQueries {[SlowSQLQuery]
chatQueries :: [SlowSQLQuery]
chatQueries :: [SlowSQLQuery]
chatQueries, [SlowSQLQuery]
agentQueries :: [SlowSQLQuery]
agentQueries :: [SlowSQLQuery]
agentQueries}
    where
      slowQueries :: DBStore -> m [SlowSQLQuery]
slowQueries DBStore
st =
        IO [SlowSQLQuery] -> m [SlowSQLQuery]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SlowSQLQuery] -> m [SlowSQLQuery])
-> IO [SlowSQLQuery] -> m [SlowSQLQuery]
forall a b. (a -> b) -> a -> b
$
          ((Query, SlowQueryStats) -> SlowSQLQuery)
-> [(Query, SlowQueryStats)] -> [SlowSQLQuery]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> SlowQueryStats -> SlowSQLQuery)
-> (Text, SlowQueryStats) -> SlowSQLQuery
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> SlowQueryStats -> SlowSQLQuery
SlowSQLQuery ((Text, SlowQueryStats) -> SlowSQLQuery)
-> ((Query, SlowQueryStats) -> (Text, SlowQueryStats))
-> (Query, SlowQueryStats)
-> SlowSQLQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Text)
-> (Query, SlowQueryStats) -> (Text, SlowQueryStats)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Query -> Text
SQL.fromQuery)
            ([(Query, SlowQueryStats)] -> [SlowSQLQuery])
-> (Map Query SlowQueryStats -> [(Query, SlowQueryStats)])
-> Map Query SlowQueryStats
-> [SlowSQLQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Query, SlowQueryStats) -> Int64)
-> [(Query, SlowQueryStats)] -> [(Query, SlowQueryStats)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (SlowQueryStats -> Int64
timeAvg (SlowQueryStats -> Int64)
-> ((Query, SlowQueryStats) -> SlowQueryStats)
-> (Query, SlowQueryStats)
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query, SlowQueryStats) -> SlowQueryStats
forall a b. (a, b) -> b
snd)
            ([(Query, SlowQueryStats)] -> [(Query, SlowQueryStats)])
-> (Map Query SlowQueryStats -> [(Query, SlowQueryStats)])
-> Map Query SlowQueryStats
-> [(Query, SlowQueryStats)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Query SlowQueryStats -> [(Query, SlowQueryStats)]
forall k a. Map k a -> [(k, a)]
M.assocs
            (Map Query SlowQueryStats -> [SlowSQLQuery])
-> IO (Map Query SlowQueryStats) -> IO [SlowSQLQuery]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DBStore
-> (Connection -> IO (Map Query SlowQueryStats))
-> IO (Map Query SlowQueryStats)
forall a. DBStore -> (Connection -> IO a) -> IO a
withConnection DBStore
st (TVar (Map Query SlowQueryStats) -> IO (Map Query SlowQueryStats)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO (TVar (Map Query SlowQueryStats) -> IO (Map Query SlowQueryStats))
-> (Connection -> TVar (Map Query SlowQueryStats))
-> Connection
-> IO (Map Query SlowQueryStats)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> TVar (Map Query SlowQueryStats)
DB.slow)
#endif
  ExecChatStoreSQL Text
query -> [Text] -> ChatResponse
CRSQLResult ([Text] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [Text]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [Text])
-> ExceptT ChatError (ReaderT ChatController IO) [Text]
forall a. (Connection -> IO a) -> CM a
withStore' (Connection -> Text -> IO [Text]
`execSQL` Text
query)
  ExecAgentStoreSQL Text
query -> [Text] -> ChatResponse
CRSQLResult ([Text] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [Text]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> ExceptT AgentErrorType IO [Text])
-> ExceptT ChatError (ReaderT ChatController IO) [Text]
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (AgentClient -> Text -> ExceptT AgentErrorType IO [Text]
`execAgentStoreSQL` Text
query)
  APISaveAppSettings AppSettings
as -> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> AppSettings -> IO ()
`saveAppSettings` AppSettings
as) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  APIGetAppSettings Maybe AppSettings
platformDefaults -> AppSettings -> ChatResponse
CRAppSettings (AppSettings -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) AppSettings
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO AppSettings)
-> ExceptT ChatError (ReaderT ChatController IO) AppSettings
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> Maybe AppSettings -> IO AppSettings
`getAppSettings` Maybe AppSettings
platformDefaults)
  APIGetChatTags Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId' Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [ChatTag]
tags <- (Connection -> IO [ChatTag]) -> CM [ChatTag]
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO [ChatTag]
`getUserChatTags` User
user)
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [ChatTag] -> ChatResponse
CRChatTags User
user [ChatTag]
tags
  APIGetChats {Int64
userId :: Int64
userId :: ChatCommand -> Int64
userId, Bool
pendingConnections :: Bool
pendingConnections :: ChatCommand -> Bool
pendingConnections, PaginationByTime
pagination :: PaginationByTime
pagination :: ChatCommand -> PaginationByTime
pagination, ChatListQuery
query :: ChatListQuery
query :: ChatCommand -> ChatListQuery
query} -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId' Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ([StoreError]
errs, [AChat]
previews) <- [Either StoreError AChat] -> ([StoreError], [AChat])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either StoreError AChat] -> ([StoreError], [AChat]))
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either StoreError AChat]
-> ExceptT
     ChatError (ReaderT ChatController IO) ([StoreError], [AChat])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [Either StoreError AChat])
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either StoreError AChat]
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Bool
-> PaginationByTime
-> ChatListQuery
-> IO [Either StoreError AChat]
getChatPreviews Connection
db VersionRangeChat
vr User
user Bool
pendingConnections PaginationByTime
pagination ChatListQuery
query)
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([StoreError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StoreError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors ((StoreError -> ChatError) -> [StoreError] -> [ChatError]
forall a b. (a -> b) -> [a] -> [b]
map StoreError -> ChatError
ChatErrorStore [StoreError]
errs)
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [AChat] -> ChatResponse
CRApiChats User
user [AChat]
previews
  APIGetChat (ChatRef ChatType
cType Int64
cId Maybe GroupChatScope
scope_) Maybe MsgContentTag
contentFilter ChatPagination
pagination Maybe Text
search -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
cType of
    -- TODO optimize queries calculating ChatStats, currently they're disabled
    ChatType
CTDirect -> do
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe MsgContentTag -> Bool
forall a. Maybe a -> Bool
isJust Maybe MsgContentTag
contentFilter) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"content filter not supported"
      (Chat 'CTDirect
directChat, Maybe NavigationInfo
navInfo) <- (Connection
 -> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo))
-> CM (Chat 'CTDirect, Maybe NavigationInfo)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ChatPagination
-> Maybe Text
-> ExceptT StoreError IO (Chat 'CTDirect, Maybe NavigationInfo)
getDirectChat Connection
db VersionRangeChat
vr User
user Int64
cId ChatPagination
pagination Maybe Text
search)
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChat -> Maybe NavigationInfo -> ChatResponse
CRApiChat User
user (SChatType 'CTDirect -> Chat 'CTDirect -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTDirect
SCTDirect Chat 'CTDirect
directChat) Maybe NavigationInfo
navInfo
    ChatType
CTGroup -> do
      (Chat 'CTGroup
groupChat, Maybe NavigationInfo
navInfo) <- (Connection
 -> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo))
-> CM (Chat 'CTGroup, Maybe NavigationInfo)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> Maybe GroupChatScope
-> Maybe MsgContentTag
-> ChatPagination
-> Maybe Text
-> ExceptT StoreError IO (Chat 'CTGroup, Maybe NavigationInfo)
getGroupChat Connection
db VersionRangeChat
vr User
user Int64
cId Maybe GroupChatScope
scope_ Maybe MsgContentTag
contentFilter ChatPagination
pagination Maybe Text
search)
      Chat 'CTGroup
groupChat' <- User -> Chat 'CTGroup -> CM (Chat 'CTGroup)
checkSupportChatAttention User
user Chat 'CTGroup
groupChat
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChat -> Maybe NavigationInfo -> ChatResponse
CRApiChat User
user (SChatType 'CTGroup -> Chat 'CTGroup -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTGroup
SCTGroup Chat 'CTGroup
groupChat') Maybe NavigationInfo
navInfo
    ChatType
CTLocal -> do
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe MsgContentTag -> Bool
forall a. Maybe a -> Bool
isJust Maybe MsgContentTag
contentFilter) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"content filter not supported"
      (Chat 'CTLocal
localChat, Maybe NavigationInfo
navInfo) <- (Connection
 -> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo))
-> CM (Chat 'CTLocal, Maybe NavigationInfo)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> User
-> Int64
-> ChatPagination
-> Maybe Text
-> ExceptT StoreError IO (Chat 'CTLocal, Maybe NavigationInfo)
getLocalChat Connection
db User
user Int64
cId ChatPagination
pagination Maybe Text
search)
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChat -> Maybe NavigationInfo -> ChatResponse
CRApiChat User
user (SChatType 'CTLocal -> Chat 'CTLocal -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTLocal
SCTLocal Chat 'CTLocal
localChat) Maybe NavigationInfo
navInfo
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not implemented"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    where
      checkSupportChatAttention :: User -> Chat 'CTGroup -> CM (Chat 'CTGroup)
      checkSupportChatAttention :: User -> Chat 'CTGroup -> CM (Chat 'CTGroup)
checkSupportChatAttention User
user groupChat :: Chat 'CTGroup
groupChat@Chat {ChatInfo 'CTGroup
chatInfo :: ChatInfo 'CTGroup
chatInfo :: forall (c :: ChatType). Chat c -> ChatInfo c
chatInfo, [CChatItem 'CTGroup]
chatItems :: [CChatItem 'CTGroup]
chatItems :: forall (c :: ChatType). Chat c -> [CChatItem c]
chatItems} =
        case ChatInfo 'CTGroup
chatInfo of
          GroupChat GroupInfo
gInfo (Just GCSIMemberSupport {groupMember_ :: GroupChatScopeInfo -> Maybe GroupMember
groupMember_ = Just scopeMem :: GroupMember
scopeMem@GroupMember {supportChat :: GroupMember -> Maybe GroupSupportChat
supportChat = Just GroupSupportChat
suppChat}}) -> do
            case Int64 -> GroupSupportChat -> [CChatItem 'CTGroup] -> Maybe Int64
correctedMemAttention (GroupMember -> Int64
groupMemberId' GroupMember
scopeMem) GroupSupportChat
suppChat [CChatItem 'CTGroup]
chatItems of
              Just Int64
newMemAttention -> do
                (GroupInfo
gInfo', GroupMember
scopeMem') <-
                  (Connection -> IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> Int64
-> IO (GroupInfo, GroupMember)
setSupportChatMemberAttention Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
scopeMem Int64
newMemAttention
                Chat 'CTGroup -> CM (Chat 'CTGroup)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chat 'CTGroup
groupChat {chatInfo = GroupChat gInfo' (Just $ GCSIMemberSupport (Just scopeMem'))} :: Chat 'CTGroup)
              Maybe Int64
Nothing -> Chat 'CTGroup -> CM (Chat 'CTGroup)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Chat 'CTGroup
groupChat
          ChatInfo 'CTGroup
_ -> Chat 'CTGroup -> CM (Chat 'CTGroup)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Chat 'CTGroup
groupChat
        where
          correctedMemAttention :: GroupMemberId -> GroupSupportChat -> [CChatItem 'CTGroup] -> Maybe Int64
          correctedMemAttention :: Int64 -> GroupSupportChat -> [CChatItem 'CTGroup] -> Maybe Int64
correctedMemAttention Int64
scopeGMId GroupSupportChat {Int64
memberAttention :: Int64
memberAttention :: GroupSupportChat -> Int64
memberAttention} [CChatItem 'CTGroup]
items =
            let numNewFromMember :: Int64
numNewFromMember = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64)
-> ([CChatItem 'CTGroup] -> Int) -> [CChatItem 'CTGroup] -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CChatItem 'CTGroup] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([CChatItem 'CTGroup] -> Int)
-> ([CChatItem 'CTGroup] -> [CChatItem 'CTGroup])
-> [CChatItem 'CTGroup]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CChatItem 'CTGroup -> Bool)
-> [CChatItem 'CTGroup] -> [CChatItem 'CTGroup]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile CChatItem 'CTGroup -> Bool
newFromMember ([CChatItem 'CTGroup] -> Int64) -> [CChatItem 'CTGroup] -> Int64
forall a b. (a -> b) -> a -> b
$ [CChatItem 'CTGroup] -> [CChatItem 'CTGroup]
forall a. [a] -> [a]
reverse [CChatItem 'CTGroup]
items
             in if Int64
numNewFromMember Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
memberAttention then Maybe Int64
forall a. Maybe a
Nothing else Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
numNewFromMember
            where
              newFromMember :: CChatItem 'CTGroup -> Bool
              newFromMember :: CChatItem 'CTGroup -> Bool
newFromMember (CChatItem SMsgDirection d
_ ChatItem {chatDir :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIDirection c d
chatDir = CIGroupRcv GroupMember
m, meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {itemStatus :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> CIStatus d
itemStatus = CIStatus d
CISRcvNew}}) =
                GroupMember -> Int64
groupMemberId' GroupMember
m Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
scopeGMId
              newFromMember CChatItem 'CTGroup
_ = Bool
False
  APIGetChatItems ChatPagination
pagination Maybe Text
search -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [AChatItem]
chatItems <- (Connection -> ExceptT StoreError IO [AChatItem]) -> CM [AChatItem]
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO [AChatItem])
 -> CM [AChatItem])
-> (Connection -> ExceptT StoreError IO [AChatItem])
-> CM [AChatItem]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> ChatPagination
-> Maybe Text
-> ExceptT StoreError IO [AChatItem]
getAllChatItems Connection
db VersionRangeChat
vr User
user ChatPagination
pagination Maybe Text
search
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe ChatName -> [AChatItem] -> ChatResponse
CRChatItems User
user Maybe ChatName
forall a. Maybe a
Nothing [AChatItem]
chatItems
  APIGetChatItemInfo ChatRef
chatRef Int64
itemId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (aci :: AChatItem
aci@(AChatItem SChatType c
cType SMsgDirection d
dir ChatInfo c
_ ChatItem c d
ci), [ChatItemVersion]
versions) <- (Connection
 -> ExceptT StoreError IO (AChatItem, [ChatItemVersion]))
-> CM (AChatItem, [ChatItemVersion])
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (AChatItem, [ChatItemVersion]))
 -> CM (AChatItem, [ChatItemVersion]))
-> (Connection
    -> ExceptT StoreError IO (AChatItem, [ChatItemVersion]))
-> CM (AChatItem, [ChatItemVersion])
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
      (,) (AChatItem -> [ChatItemVersion] -> (AChatItem, [ChatItemVersion]))
-> ExceptT StoreError IO AChatItem
-> ExceptT
     StoreError IO ([ChatItemVersion] -> (AChatItem, [ChatItemVersion]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> ChatRef
-> Int64
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user ChatRef
chatRef Int64
itemId ExceptT
  StoreError IO ([ChatItemVersion] -> (AChatItem, [ChatItemVersion]))
-> ExceptT StoreError IO [ChatItemVersion]
-> ExceptT StoreError IO (AChatItem, [ChatItemVersion])
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [ChatItemVersion] -> ExceptT StoreError IO [ChatItemVersion]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> Int64 -> IO [ChatItemVersion]
getChatItemVersions Connection
db Int64
itemId)
    let itemVersions :: [ChatItemVersion]
itemVersions = if [ChatItemVersion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatItemVersion]
versions then Maybe ChatItemVersion -> [ChatItemVersion]
forall a. Maybe a -> [a]
maybeToList (Maybe ChatItemVersion -> [ChatItemVersion])
-> Maybe ChatItemVersion -> [ChatItemVersion]
forall a b. (a -> b) -> a -> b
$ ChatItem c d -> Maybe ChatItemVersion
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe ChatItemVersion
mkItemVersion ChatItem c d
ci else [ChatItemVersion]
versions
    Maybe (NonEmpty MemberDeliveryStatus)
memberDeliveryStatuses <- case (SChatType c
cType, SMsgDirection d
dir) of
      (SChatType c
SCTGroup, SMsgDirection d
SMDSnd) -> [MemberDeliveryStatus] -> Maybe (NonEmpty MemberDeliveryStatus)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([MemberDeliveryStatus] -> Maybe (NonEmpty MemberDeliveryStatus))
-> ExceptT
     ChatError (ReaderT ChatController IO) [MemberDeliveryStatus]
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (NonEmpty MemberDeliveryStatus))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [MemberDeliveryStatus])
-> ExceptT
     ChatError (ReaderT ChatController IO) [MemberDeliveryStatus]
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> Int64 -> IO [MemberDeliveryStatus]
`getGroupSndStatuses` Int64
itemId)
      (SChatType c, SMsgDirection d)
_ -> Maybe (NonEmpty MemberDeliveryStatus)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (NonEmpty MemberDeliveryStatus))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NonEmpty MemberDeliveryStatus)
forall a. Maybe a
Nothing
    Maybe AChatItem
forwardedFromChatItem <- User -> ChatItem c d -> CM (Maybe AChatItem)
forall (c :: ChatType) (d :: MsgDirection).
User -> ChatItem c d -> CM (Maybe AChatItem)
getForwardedFromItem User
user ChatItem c d
ci
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatItemInfo -> ChatResponse
CRChatItemInfo User
user AChatItem
aci ChatItemInfo {[ChatItemVersion]
itemVersions :: [ChatItemVersion]
itemVersions :: [ChatItemVersion]
itemVersions, Maybe (NonEmpty MemberDeliveryStatus)
memberDeliveryStatuses :: Maybe (NonEmpty MemberDeliveryStatus)
memberDeliveryStatuses :: Maybe (NonEmpty MemberDeliveryStatus)
memberDeliveryStatuses, Maybe AChatItem
forwardedFromChatItem :: Maybe AChatItem
forwardedFromChatItem :: Maybe AChatItem
forwardedFromChatItem}
    where
      getForwardedFromItem :: User -> ChatItem c d -> CM (Maybe AChatItem)
      getForwardedFromItem :: forall (c :: ChatType) (d :: MsgDirection).
User -> ChatItem c d -> CM (Maybe AChatItem)
getForwardedFromItem User
user ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe CIForwardedFrom
itemForwarded :: Maybe CIForwardedFrom
itemForwarded :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CIForwardedFrom
itemForwarded}} = case Maybe CIForwardedFrom
itemForwarded of
        Just (CIFFContact Text
_ MsgDirection
_ (Just Int64
ctId) (Just Int64
fwdItemId)) ->
          AChatItem -> Maybe AChatItem
forall a. a -> Maybe a
Just (AChatItem -> Maybe AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> CM (Maybe AChatItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> ChatRef
-> Int64
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
ctId Maybe GroupChatScope
forall a. Maybe a
Nothing) Int64
fwdItemId)
        Just (CIFFGroup Text
_ MsgDirection
_ (Just Int64
gId) (Just Int64
fwdItemId)) ->
          -- TODO [knocking] getAChatItem doesn't differentiate how to read based on scope - it should, instead of using group filter
          AChatItem -> Maybe AChatItem
forall a. a -> Maybe a
Just (AChatItem -> Maybe AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> CM (Maybe AChatItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> ChatRef
-> Int64
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup Int64
gId Maybe GroupChatScope
forall a. Maybe a
Nothing) Int64
fwdItemId)
        Maybe CIForwardedFrom
_ -> Maybe AChatItem -> CM (Maybe AChatItem)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe AChatItem
forall a. Maybe a
Nothing
  APISendMessages SendRef
sendRef Bool
live Maybe Int
itemTTL NonEmpty ComposedMessage
cms -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> (ComposedMessage
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> NonEmpty ComposedMessage
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ComposedMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
assertAllowedContent' NonEmpty ComposedMessage
cms ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case SendRef
sendRef of
    SRDirect Int64
chatId -> do
      (ComposedMessage
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> NonEmpty ComposedMessage
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ComposedMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
assertNoMentions NonEmpty ComposedMessage
cms
      Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"sendMessage" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
        User
-> Int64
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendContactContentMessages User
user Int64
chatId Bool
live Maybe Int
itemTTL ((ComposedMessage -> ComposedMessageReq)
-> NonEmpty ComposedMessage -> NonEmpty ComposedMessageReq
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map ComposedMessage -> ComposedMessageReq
composedMessageReq NonEmpty ComposedMessage
cms)
    SRGroup Int64
chatId Maybe GroupChatScope
gsScope ->
      Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"sendMessage" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
        (GroupInfo
gInfo, NonEmpty ComposedMessageReq
cmrs) <- (Connection
 -> ExceptT StoreError IO (GroupInfo, NonEmpty ComposedMessageReq))
-> CM (GroupInfo, NonEmpty ComposedMessageReq)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (GroupInfo, NonEmpty ComposedMessageReq))
 -> CM (GroupInfo, NonEmpty ComposedMessageReq))
-> (Connection
    -> ExceptT StoreError IO (GroupInfo, NonEmpty ComposedMessageReq))
-> CM (GroupInfo, NonEmpty ComposedMessageReq)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
          (GroupInfo
g,) (NonEmpty ComposedMessageReq
 -> (GroupInfo, NonEmpty ComposedMessageReq))
-> ExceptT StoreError IO (NonEmpty ComposedMessageReq)
-> ExceptT StoreError IO (GroupInfo, NonEmpty ComposedMessageReq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ComposedMessage -> ExceptT StoreError IO ComposedMessageReq)
-> NonEmpty ComposedMessage
-> ExceptT StoreError IO (NonEmpty ComposedMessageReq)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (Connection
-> User
-> GroupInfo
-> ComposedMessage
-> ExceptT StoreError IO ComposedMessageReq
composedMessageReqMentions Connection
db User
user GroupInfo
g) NonEmpty ComposedMessage
cms
        User
-> GroupInfo
-> Maybe GroupChatScope
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendGroupContentMessages User
user GroupInfo
gInfo Maybe GroupChatScope
gsScope Bool
live Maybe Int
itemTTL NonEmpty ComposedMessageReq
cmrs
  APICreateChatTag (ChatTagData Maybe Text
emoji Text
text) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ChatResponse) -> CM ChatResponse)
-> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
    Int64
_ <- Connection -> User -> Maybe Text -> Text -> IO Int64
createChatTag Connection
db User
user Maybe Text
emoji Text
text
    User -> [ChatTag] -> ChatResponse
CRChatTags User
user ([ChatTag] -> ChatResponse) -> IO [ChatTag] -> IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> IO [ChatTag]
getUserChatTags Connection
db User
user
  APISetChatTags (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) Maybe (NonEmpty Int64)
tagIds -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
cType of
    ChatType
CTDirect -> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ChatResponse) -> CM ChatResponse)
-> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Connection -> Int64 -> [Int64] -> IO ()
updateDirectChatTags Connection
db Int64
chatId ([Int64]
-> (NonEmpty Int64 -> [Int64]) -> Maybe (NonEmpty Int64) -> [Int64]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty Int64 -> [Int64]
forall a. NonEmpty a -> [a]
L.toList Maybe (NonEmpty Int64)
tagIds)
      User -> [ChatTag] -> [Int64] -> ChatResponse
CRTagsUpdated User
user ([ChatTag] -> [Int64] -> ChatResponse)
-> IO [ChatTag] -> IO ([Int64] -> ChatResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> IO [ChatTag]
getUserChatTags Connection
db User
user IO ([Int64] -> ChatResponse) -> IO [Int64] -> IO ChatResponse
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> Int64 -> IO [Int64]
getDirectChatTags Connection
db Int64
chatId
    ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope -> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ChatResponse) -> CM ChatResponse)
-> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Connection -> Int64 -> [Int64] -> IO ()
updateGroupChatTags Connection
db Int64
chatId ([Int64]
-> (NonEmpty Int64 -> [Int64]) -> Maybe (NonEmpty Int64) -> [Int64]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NonEmpty Int64 -> [Int64]
forall a. NonEmpty a -> [a]
L.toList Maybe (NonEmpty Int64)
tagIds)
      User -> [ChatTag] -> [Int64] -> ChatResponse
CRTagsUpdated User
user ([ChatTag] -> [Int64] -> ChatResponse)
-> IO [ChatTag] -> IO ([Int64] -> ChatResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> IO [ChatTag]
getUserChatTags Connection
db User
user IO ([Int64] -> ChatResponse) -> IO [Int64] -> IO ChatResponse
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> Int64 -> IO [Int64]
getGroupChatTags Connection
db Int64
chatId
    ChatType
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APIDeleteChatTag Int64
tagId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> IO ()
deleteChatTag Connection
db User
user Int64
tagId
    User -> CM ChatResponse
ok User
user
  APIUpdateChatTag Int64
tagId (ChatTagData Maybe Text
emoji Text
text) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Maybe Text -> Text -> IO ()
updateChatTag Connection
db User
user Int64
tagId Maybe Text
emoji Text
text
    User -> CM ChatResponse
ok User
user
  APIReorderChatTags NonEmpty Int64
tagIds -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> [Int64] -> IO ()
reorderChatTags Connection
db User
user ([Int64] -> IO ()) -> [Int64] -> IO ()
forall a b. (a -> b) -> a -> b
$ NonEmpty Int64 -> [Int64]
forall a. NonEmpty a -> [a]
L.toList NonEmpty Int64
tagIds
    User -> CM ChatResponse
ok User
user
  APICreateChatItems Int64
folderId NonEmpty ComposedMessage
cms -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    NonEmpty ComposedMessage
-> (ComposedMessage
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty ComposedMessage
cms ((ComposedMessage
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ComposedMessage
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \ComposedMessage
cm -> ComposedMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
assertAllowedContent' ComposedMessage
cm ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ComposedMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
assertNoMentions ComposedMessage
cm
    User -> Int64 -> NonEmpty ComposedMessageReq -> CM ChatResponse
createNoteFolderContentItems User
user Int64
folderId ((ComposedMessage -> ComposedMessageReq)
-> NonEmpty ComposedMessage -> NonEmpty ComposedMessageReq
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map ComposedMessage -> ComposedMessageReq
composedMessageReq NonEmpty ComposedMessage
cms)
  APIReportMessage Int64
gId Int64
reportedItemId ReportReason
reportReason Text
reportText -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"reportMessage" Int64
gId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId
      let mc :: MsgContent
mc = Text -> ReportReason -> MsgContent
MCReport Text
reportText ReportReason
reportReason
          cm :: ComposedMessage
cm = ComposedMessage {fileSource :: Maybe CryptoFile
fileSource = Maybe CryptoFile
forall a. Maybe a
Nothing, quotedItemId :: Maybe Int64
quotedItemId = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
reportedItemId, msgContent :: MsgContent
msgContent = MsgContent
mc, mentions :: Map Text Int64
mentions = Map Text Int64
forall k a. Map k a
M.empty}
      User
-> GroupInfo
-> Maybe GroupChatScope
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendGroupContentMessages User
user GroupInfo
gInfo (GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (GroupChatScope -> Maybe GroupChatScope)
-> GroupChatScope -> Maybe GroupChatScope
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> GroupChatScope
GCSMemberSupport Maybe Int64
forall a. Maybe a
Nothing) Bool
False Maybe Int
forall a. Maybe a
Nothing [ComposedMessage -> ComposedMessageReq
composedMessageReq ComposedMessage
cm]
  ReportMessage {Text
groupName :: Text
groupName :: ChatCommand -> Text
groupName, Maybe Text
contactName_ :: Maybe Text
contactName_ :: ChatCommand -> Maybe Text
contactName_, ReportReason
reportReason :: ReportReason
reportReason :: ChatCommand -> ReportReason
reportReason, Text
reportedMessage :: Text
reportedMessage :: ChatCommand -> Text
reportedMessage} -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
gId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
groupName
    Int64
reportedItemId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> Int64
-> Maybe Text
-> Text
-> ExceptT StoreError IO Int64
getGroupChatItemIdByText Connection
db User
user Int64
gId Maybe Text
contactName_ Text
reportedMessage
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> ReportReason -> Text -> ChatCommand
APIReportMessage Int64
gId Int64
reportedItemId ReportReason
reportReason Text
""
  APIUpdateChatItem (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) Int64
itemId Bool
live (UpdatedMessage MsgContent
mc Map Text Int64
mentions) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ()
assertAllowedContent MsgContent
mc ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case ChatType
cType of
    ChatType
CTDirect -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"updateChatItem" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Text Int64 -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Int64
mentions) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"mentions are not supported in this chat"
      ct :: Contact
ct@Contact {Int64
contactId :: Int64
contactId :: Contact -> Int64
contactId} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
      User
-> MsgDirection
-> Contact
-> CMEventTag 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (e :: MsgEncoding).
User
-> MsgDirection
-> Contact
-> CMEventTag e
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDirectAllowed User
user MsgDirection
MDSnd Contact
ct CMEventTag 'Json
XMsgUpdate_
      CChatItem 'CTDirect
cci <- (Connection -> ExceptT StoreError IO (CChatItem 'CTDirect))
-> CM (CChatItem 'CTDirect)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (CChatItem 'CTDirect))
 -> CM (CChatItem 'CTDirect))
-> (Connection -> ExceptT StoreError IO (CChatItem 'CTDirect))
-> CM (CChatItem 'CTDirect)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> Contact
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectCIWithReactions Connection
db User
user Contact
ct Int64
itemId
      case CChatItem 'CTDirect
cci of
        CChatItem SMsgDirection d
SMDSnd ci :: ChatItem 'CTDirect d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId, Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CITimed
itemTimed, Maybe Bool
itemLive :: Maybe Bool
itemLive :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Bool
itemLive, Bool
editable :: Bool
editable :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
editable}, content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CIContent d
ciContent} -> do
          case (CIContent d
ciContent, Maybe SharedMsgId
itemSharedMsgId, Bool
editable) of
            (CISndMsgContent MsgContent
oldMC, Just SharedMsgId
itemSharedMId, Bool
True) -> do
              let changed :: Bool
changed = MsgContent
mc MsgContent -> MsgContent -> Bool
forall a. Eq a => a -> a -> Bool
/= MsgContent
oldMC
              if Bool
changed Bool -> Bool -> Bool
|| Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
itemLive
                then do
                  let event :: ChatMsgEvent 'Json
event = SharedMsgId
-> MsgContent
-> Map Text MsgMention
-> Maybe Int
-> Maybe Bool
-> Maybe MsgScope
-> ChatMsgEvent 'Json
XMsgUpdate SharedMsgId
itemSharedMId MsgContent
mc Map Text MsgMention
forall k a. Map k a
M.empty (CITimed -> Int
ttl' (CITimed -> Int) -> Maybe CITimed -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CITimed
itemTimed) (Bool -> Maybe Bool
justTrue (Bool -> Maybe Bool) -> (Bool -> Bool) -> Bool -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
live Bool -> Bool -> Bool
&&) (Bool -> Maybe Bool) -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Bool
itemLive) Maybe MsgScope
forall a. Maybe a
Nothing
                  (SndMessage {Int64
msgId :: Int64
msgId :: SndMessage -> Int64
msgId}, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct ChatMsgEvent 'Json
event
                  ChatItem 'CTDirect d
ci' <- (Connection -> IO (ChatItem 'CTDirect d))
-> CM (ChatItem 'CTDirect d)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (ChatItem 'CTDirect d))
 -> CM (ChatItem 'CTDirect d))
-> (Connection -> IO (ChatItem 'CTDirect d))
-> CM (ChatItem 'CTDirect d)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
                    UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                      Connection
-> Int64 -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO ()
addInitialAndNewCIVersions Connection
db Int64
itemId (ChatItem 'CTDirect d -> UTCTime
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
chatItemTs' ChatItem 'CTDirect d
ci, MsgContent
oldMC) (UTCTime
currentTs, MsgContent
mc)
                    let edited :: Bool
edited = Maybe Bool
itemLive Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                    Connection
-> User
-> Int64
-> ChatItem 'CTDirect d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe Int64
-> IO (ChatItem 'CTDirect d)
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> Int64
-> ChatItem 'CTDirect d
-> CIContent d
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe Int64
-> IO (ChatItem 'CTDirect d)
updateDirectChatItem' Connection
db User
user Int64
contactId ChatItem 'CTDirect d
ci (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc) Bool
edited Bool
live Maybe CITimed
forall a. Maybe a
Nothing (Maybe Int64 -> IO (ChatItem 'CTDirect d))
-> Maybe Int64 -> IO (ChatItem 'CTDirect d)
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
msgId
                  User
-> ChatRef
-> ChatItem 'CTDirect d
-> ChatItem 'CTDirect d
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
User
-> ChatRef
-> ChatItem c d
-> ChatItem c d
-> ExceptT ChatError (ReaderT ChatController IO) ()
startUpdatedTimedItemThread User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing) ChatItem 'CTDirect d
ci ChatItem 'CTDirect d
ci'
                  ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatResponse
CRChatItemUpdated User
user (SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ChatItem 'CTDirect d
ChatItem 'CTDirect 'MDSnd
ci')
                else ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatResponse
CRChatItemNotChanged User
user (SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ChatItem 'CTDirect d
ChatItem 'CTDirect 'MDSnd
ci)
            (CIContent d, Maybe SharedMsgId, Bool)
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidChatItemUpdate
        CChatItem SMsgDirection d
SMDRcv ChatItem 'CTDirect d
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidChatItemUpdate
    ChatType
CTGroup -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"updateChatItem" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      gInfo :: GroupInfo
gInfo@GroupInfo {Int64
groupId :: Int64
groupId :: GroupInfo -> Int64
groupId, GroupMember
membership :: GroupMember
membership :: GroupInfo -> GroupMember
membership} <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo GroupMemberRole
GRAuthor
      let (Text
_, Maybe MarkdownList
ft_) = MsgContent -> (Text, Maybe MarkdownList)
msgContentTexts MsgContent
mc
      if GroupInfo -> GroupMember -> Maybe MarkdownList -> Bool
prohibitedSimplexLinks GroupInfo
gInfo GroupMember
membership Maybe MarkdownList
ft_
        then String -> CM ChatResponse
forall a. String -> CM a
throwCmdError (String
"feature not allowed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (GroupFeature -> Text
groupFeatureNameText GroupFeature
GFSimplexLinks))
        else do
          -- TODO [knocking] check chat item scope?
          CChatItem 'CTGroup
cci <- (Connection -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> CM (CChatItem 'CTGroup)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (CChatItem 'CTGroup))
 -> CM (CChatItem 'CTGroup))
-> (Connection -> ExceptT StoreError IO (CChatItem 'CTGroup))
-> CM (CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> GroupInfo
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
gInfo Int64
itemId
          case CChatItem 'CTGroup
cci of
            CChatItem SMsgDirection d
SMDSnd ci :: ChatItem 'CTGroup d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId, Maybe CITimed
itemTimed :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CITimed
itemTimed :: Maybe CITimed
itemTimed, Maybe Bool
itemLive :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe Bool
itemLive :: Maybe Bool
itemLive, Bool
editable :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Bool
editable :: Bool
editable}, content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CIContent d
ciContent} -> do
              case (CIContent d
ciContent, Maybe SharedMsgId
itemSharedMsgId, Bool
editable) of
                (CISndMsgContent MsgContent
oldMC, Just SharedMsgId
itemSharedMId, Bool
True) -> do
                  Maybe GroupChatScopeInfo
chatScopeInfo <- (GroupChatScope
 -> ExceptT
      ChatError (ReaderT ChatController IO) GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (VersionRangeChat
-> User
-> GroupChatScope
-> ExceptT ChatError (ReaderT ChatController IO) GroupChatScopeInfo
getChatScopeInfo VersionRangeChat
vr User
user) Maybe GroupChatScope
scope
                  [GroupMember]
recipients <- VersionRangeChat
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Version ChatVersion
-> CM [GroupMember]
getGroupRecipients VersionRangeChat
vr User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo Version ChatVersion
groupKnockingVersion
                  let changed :: Bool
changed = MsgContent
mc MsgContent -> MsgContent -> Bool
forall a. Eq a => a -> a -> Bool
/= MsgContent
oldMC
                  if Bool
changed Bool -> Bool -> Bool
|| Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
itemLive
                    then do
                      Map Text CIMention
ciMentions <- (Connection -> ExceptT StoreError IO (Map Text CIMention))
-> CM (Map Text CIMention)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Map Text CIMention))
 -> CM (Map Text CIMention))
-> (Connection -> ExceptT StoreError IO (Map Text CIMention))
-> CM (Map Text CIMention)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> GroupInfo
-> Maybe MarkdownList
-> Map Text Int64
-> ExceptT StoreError IO (Map Text CIMention)
getCIMentions Connection
db User
user GroupInfo
gInfo Maybe MarkdownList
ft_ Map Text Int64
mentions
                      let msgScope :: Maybe MsgScope
msgScope = GroupInfo -> GroupChatScopeInfo -> MsgScope
toMsgScope GroupInfo
gInfo (GroupChatScopeInfo -> MsgScope)
-> Maybe GroupChatScopeInfo -> Maybe MsgScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupChatScopeInfo
chatScopeInfo
                          mentions' :: Map Text MsgMention
mentions' = (CIMention -> MsgMention)
-> Map Text CIMention -> Map Text MsgMention
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\CIMention {MemberId
memberId :: MemberId
memberId :: CIMention -> MemberId
memberId} -> MsgMention {MemberId
memberId :: MemberId
memberId :: MemberId
memberId}) Map Text CIMention
ciMentions
                          event :: ChatMsgEvent 'Json
event = SharedMsgId
-> MsgContent
-> Map Text MsgMention
-> Maybe Int
-> Maybe Bool
-> Maybe MsgScope
-> ChatMsgEvent 'Json
XMsgUpdate SharedMsgId
itemSharedMId MsgContent
mc Map Text MsgMention
mentions' (CITimed -> Int
ttl' (CITimed -> Int) -> Maybe CITimed -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CITimed
itemTimed) (Bool -> Maybe Bool
justTrue (Bool -> Maybe Bool) -> (Bool -> Bool) -> Bool -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
live Bool -> Bool -> Bool
&&) (Bool -> Maybe Bool) -> Maybe Bool -> Maybe Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Bool
itemLive) Maybe MsgScope
msgScope
                      SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId} <- User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent e
-> CM SndMessage
sendGroupMessage User
user GroupInfo
gInfo Maybe GroupChatScope
scope [GroupMember]
recipients ChatMsgEvent 'Json
event
                      ChatItem 'CTGroup d
ci' <- (Connection -> IO (ChatItem 'CTGroup d))
-> CM (ChatItem 'CTGroup d)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (ChatItem 'CTGroup d))
 -> CM (ChatItem 'CTGroup d))
-> (Connection -> IO (ChatItem 'CTGroup d))
-> CM (ChatItem 'CTGroup d)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
                        UTCTime
currentTs <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                          Connection
-> Int64 -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO ()
addInitialAndNewCIVersions Connection
db Int64
itemId (ChatItem 'CTGroup d -> UTCTime
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
chatItemTs' ChatItem 'CTGroup d
ci, MsgContent
oldMC) (UTCTime
currentTs, MsgContent
mc)
                        let edited :: Bool
edited = Maybe Bool
itemLive Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
                        ChatItem 'CTGroup d
ci' <- Connection
-> User
-> Int64
-> ChatItem 'CTGroup d
-> CIContent d
-> Bool
-> Bool
-> Maybe Int64
-> IO (ChatItem 'CTGroup d)
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> Int64
-> ChatItem 'CTGroup d
-> CIContent d
-> Bool
-> Bool
-> Maybe Int64
-> IO (ChatItem 'CTGroup d)
updateGroupChatItem Connection
db User
user Int64
groupId ChatItem 'CTGroup d
ci (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc) Bool
edited Bool
live (Maybe Int64 -> IO (ChatItem 'CTGroup d))
-> Maybe Int64 -> IO (ChatItem 'CTGroup d)
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
msgId
                        Connection
-> GroupInfo
-> ChatItem 'CTGroup d
-> Map Text CIMention
-> IO (ChatItem 'CTGroup d)
forall (d :: MsgDirection).
Connection
-> GroupInfo
-> ChatItem 'CTGroup d
-> Map Text CIMention
-> IO (ChatItem 'CTGroup d)
updateGroupCIMentions Connection
db GroupInfo
gInfo ChatItem 'CTGroup d
ci' Map Text CIMention
ciMentions
                      User
-> ChatRef
-> ChatItem 'CTGroup d
-> ChatItem 'CTGroup d
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
User
-> ChatRef
-> ChatItem c d
-> ChatItem c d
-> ExceptT ChatError (ReaderT ChatController IO) ()
startUpdatedTimedItemThread User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup Int64
groupId Maybe GroupChatScope
scope) ChatItem 'CTGroup d
ci ChatItem 'CTGroup d
ci'
                      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatResponse
CRChatItemUpdated User
user (SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo) ChatItem 'CTGroup d
ChatItem 'CTGroup 'MDSnd
ci')
                    else ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatResponse
CRChatItemNotChanged User
user (SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo) ChatItem 'CTGroup d
ChatItem 'CTGroup 'MDSnd
ci)
                (CIContent d, Maybe SharedMsgId, Bool)
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidChatItemUpdate
            CChatItem SMsgDirection d
SMDRcv ChatItem 'CTGroup d
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidChatItemUpdate
    ChatType
CTLocal -> do
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Text Int64 -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Int64
mentions) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"mentions are not supported in this chat"
      (nf :: NoteFolder
nf@NoteFolder {Int64
noteFolderId :: Int64
noteFolderId :: NoteFolder -> Int64
noteFolderId}, CChatItem 'CTLocal
cci) <- (Connection
 -> ExceptT StoreError IO (NoteFolder, CChatItem 'CTLocal))
-> CM (NoteFolder, CChatItem 'CTLocal)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (NoteFolder, CChatItem 'CTLocal))
 -> CM (NoteFolder, CChatItem 'CTLocal))
-> (Connection
    -> ExceptT StoreError IO (NoteFolder, CChatItem 'CTLocal))
-> CM (NoteFolder, CChatItem 'CTLocal)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (NoteFolder
 -> CChatItem 'CTLocal -> (NoteFolder, CChatItem 'CTLocal))
-> ExceptT StoreError IO NoteFolder
-> ExceptT
     StoreError
     IO
     (CChatItem 'CTLocal -> (NoteFolder, CChatItem 'CTLocal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> Int64 -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user Int64
chatId ExceptT
  StoreError
  IO
  (CChatItem 'CTLocal -> (NoteFolder, CChatItem 'CTLocal))
-> ExceptT StoreError IO (CChatItem 'CTLocal)
-> ExceptT StoreError IO (NoteFolder, CChatItem 'CTLocal)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User
user Int64
chatId Int64
itemId
      case CChatItem 'CTLocal
cci of
        CChatItem SMsgDirection d
SMDSnd ci :: ChatItem 'CTLocal d
ci@ChatItem {content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CISndMsgContent MsgContent
oldMC}
          | MsgContent
mc MsgContent -> MsgContent -> Bool
forall a. Eq a => a -> a -> Bool
== MsgContent
oldMC -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatResponse
CRChatItemNotChanged User
user (SChatType 'CTLocal
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTLocal
-> ChatItem 'CTLocal 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTLocal
SCTLocal SMsgDirection 'MDSnd
SMDSnd (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) ChatItem 'CTLocal d
ChatItem 'CTLocal 'MDSnd
ci)
          | Bool
otherwise -> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ChatResponse) -> CM ChatResponse)
-> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
              UTCTime
currentTs <- IO UTCTime
getCurrentTime
              Connection
-> Int64 -> (UTCTime, MsgContent) -> (UTCTime, MsgContent) -> IO ()
addInitialAndNewCIVersions Connection
db Int64
itemId (ChatItem 'CTLocal d -> UTCTime
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
chatItemTs' ChatItem 'CTLocal d
ci, MsgContent
oldMC) (UTCTime
currentTs, MsgContent
mc)
              ChatItem 'CTLocal d
ci' <- Connection
-> User
-> Int64
-> ChatItem 'CTLocal d
-> CIContent d
-> Bool
-> IO (ChatItem 'CTLocal d)
forall (d :: MsgDirection).
MsgDirectionI d =>
Connection
-> User
-> Int64
-> ChatItem 'CTLocal d
-> CIContent d
-> Bool
-> IO (ChatItem 'CTLocal d)
updateLocalChatItem' Connection
db User
user Int64
noteFolderId ChatItem 'CTLocal d
ci (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc) Bool
True
              ChatResponse -> IO ChatResponse
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> IO ChatResponse)
-> ChatResponse -> IO ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatResponse
CRChatItemUpdated User
user (SChatType 'CTLocal
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTLocal
-> ChatItem 'CTLocal 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTLocal
SCTLocal SMsgDirection 'MDSnd
SMDSnd (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf) ChatItem 'CTLocal d
ChatItem 'CTLocal 'MDSnd
ci')
        CChatItem 'CTLocal
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidChatItemUpdate
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APIDeleteChatItem (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) NonEmpty Int64
itemIds CIDeleteMode
mode -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
cType of
    ChatType
CTDirect -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"deleteChatItem" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      (Contact
ct, [CChatItem 'CTDirect]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (Contact, [CChatItem 'CTDirect])
getCommandDirectChatItems User
user Int64
chatId NonEmpty Int64
itemIds
      [ChatItemDeletion]
deletions <- case CIDeleteMode
mode of
        CIDeleteMode
CIDMInternal -> User
-> Contact
-> [CChatItem 'CTDirect]
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
deleteDirectCIs User
user Contact
ct [CChatItem 'CTDirect]
items
        CIDeleteMode
CIDMInternalMark -> User
-> Contact
-> [CChatItem 'CTDirect]
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
markDirectCIsDeleted User
user Contact
ct [CChatItem 'CTDirect]
items (UTCTime
 -> ExceptT
      ChatError (ReaderT ChatController IO) [ChatItemDeletion])
-> ExceptT ChatError (ReaderT ChatController IO) UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        CIDeleteMode
CIDMBroadcast -> do
          [CChatItem 'CTDirect]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType).
ChatTypeI c =>
[CChatItem c] -> ExceptT ChatError (ReaderT ChatController IO) ()
assertDeletable [CChatItem 'CTDirect]
items
          User
-> MsgDirection
-> Contact
-> CMEventTag 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (e :: MsgEncoding).
User
-> MsgDirection
-> Contact
-> CMEventTag e
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDirectAllowed User
user MsgDirection
MDSnd Contact
ct CMEventTag 'Json
XMsgDel_
          let msgIds :: [SharedMsgId]
msgIds = [CChatItem 'CTDirect] -> [SharedMsgId]
forall (c :: ChatType). [CChatItem c] -> [SharedMsgId]
itemsMsgIds [CChatItem 'CTDirect]
items
              events :: [ChatMsgEvent 'Json]
events = (SharedMsgId -> ChatMsgEvent 'Json)
-> [SharedMsgId] -> [ChatMsgEvent 'Json]
forall a b. (a -> b) -> [a] -> [b]
map (\SharedMsgId
msgId -> SharedMsgId
-> Maybe MemberId -> Maybe MsgScope -> ChatMsgEvent 'Json
XMsgDel SharedMsgId
msgId Maybe MemberId
forall a. Maybe a
Nothing Maybe MsgScope
forall a. Maybe a
Nothing) [SharedMsgId]
msgIds
          Maybe (NonEmpty (ChatMsgEvent 'Json))
-> (NonEmpty (ChatMsgEvent 'Json)
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         [Either ChatError SndMessage])
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([ChatMsgEvent 'Json] -> Maybe (NonEmpty (ChatMsgEvent 'Json))
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [ChatMsgEvent 'Json]
events) ((NonEmpty (ChatMsgEvent 'Json)
  -> ExceptT
       ChatError
       (ReaderT ChatController IO)
       [Either ChatError SndMessage])
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (NonEmpty (ChatMsgEvent 'Json)
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         [Either ChatError SndMessage])
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \NonEmpty (ChatMsgEvent 'Json)
events' ->
            User
-> Contact
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either ChatError SndMessage]
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> Contact
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either ChatError SndMessage]
sendDirectContactMessages User
user Contact
ct NonEmpty (ChatMsgEvent 'Json)
events'
          if SChatFeature 'CFFullDelete
-> (PrefEnabled -> Bool) -> Contact -> Bool
forall (f :: ChatFeature).
SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool
featureAllowed SChatFeature 'CFFullDelete
SCFFullDelete PrefEnabled -> Bool
forUser Contact
ct
            then User
-> Contact
-> [CChatItem 'CTDirect]
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
deleteDirectCIs User
user Contact
ct [CChatItem 'CTDirect]
items
            else User
-> Contact
-> [CChatItem 'CTDirect]
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
markDirectCIsDeleted User
user Contact
ct [CChatItem 'CTDirect]
items (UTCTime
 -> ExceptT
      ChatError (ReaderT ChatController IO) [ChatItemDeletion])
-> ExceptT ChatError (ReaderT ChatController IO) UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [ChatItemDeletion] -> Bool -> Bool -> ChatResponse
CRChatItemsDeleted User
user [ChatItemDeletion]
deletions Bool
True Bool
False
    ChatType
CTGroup -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"deleteChatItem" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      (GroupInfo
gInfo, [CChatItem 'CTGroup]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (GroupInfo, [CChatItem 'CTGroup])
getCommandGroupChatItems User
user Int64
chatId NonEmpty Int64
itemIds
      -- TODO [knocking] check scope for all items?
      Maybe GroupChatScopeInfo
chatScopeInfo <- (GroupChatScope
 -> ExceptT
      ChatError (ReaderT ChatController IO) GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (VersionRangeChat
-> User
-> GroupChatScope
-> ExceptT ChatError (ReaderT ChatController IO) GroupChatScopeInfo
getChatScopeInfo VersionRangeChat
vr User
user) Maybe GroupChatScope
scope
      [ChatItemDeletion]
deletions <- case CIDeleteMode
mode of
        CIDeleteMode
CIDMInternal -> do
          User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Maybe GroupMember
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
deleteGroupCIs User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [CChatItem 'CTGroup]
items Maybe GroupMember
forall a. Maybe a
Nothing (UTCTime
 -> ExceptT
      ChatError (ReaderT ChatController IO) [ChatItemDeletion])
-> ExceptT ChatError (ReaderT ChatController IO) UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        CIDeleteMode
CIDMInternalMark -> do
          User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Maybe GroupMember
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
markGroupCIsDeleted User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [CChatItem 'CTGroup]
items Maybe GroupMember
forall a. Maybe a
Nothing (UTCTime
 -> ExceptT
      ChatError (ReaderT ChatController IO) [ChatItemDeletion])
-> ExceptT ChatError (ReaderT ChatController IO) UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        CIDeleteMode
CIDMBroadcast -> do
          [GroupMember]
recipients <- VersionRangeChat
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Version ChatVersion
-> CM [GroupMember]
getGroupRecipients VersionRangeChat
vr User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo Version ChatVersion
groupKnockingVersion
          [CChatItem 'CTGroup]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType).
ChatTypeI c =>
[CChatItem c] -> ExceptT ChatError (ReaderT ChatController IO) ()
assertDeletable [CChatItem 'CTGroup]
items
          GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo GroupMemberRole
GRObserver -- can still delete messages sent earlier
          let msgIds :: [SharedMsgId]
msgIds = [CChatItem 'CTGroup] -> [SharedMsgId]
forall (c :: ChatType). [CChatItem c] -> [SharedMsgId]
itemsMsgIds [CChatItem 'CTGroup]
items
              events :: Maybe (NonEmpty (ChatMsgEvent 'Json))
events = [ChatMsgEvent 'Json] -> Maybe (NonEmpty (ChatMsgEvent 'Json))
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([ChatMsgEvent 'Json] -> Maybe (NonEmpty (ChatMsgEvent 'Json)))
-> [ChatMsgEvent 'Json] -> Maybe (NonEmpty (ChatMsgEvent 'Json))
forall a b. (a -> b) -> a -> b
$ (SharedMsgId -> ChatMsgEvent 'Json)
-> [SharedMsgId] -> [ChatMsgEvent 'Json]
forall a b. (a -> b) -> [a] -> [b]
map (\SharedMsgId
msgId -> SharedMsgId
-> Maybe MemberId -> Maybe MsgScope -> ChatMsgEvent 'Json
XMsgDel SharedMsgId
msgId Maybe MemberId
forall a. Maybe a
Nothing (Maybe MsgScope -> ChatMsgEvent 'Json)
-> Maybe MsgScope -> ChatMsgEvent 'Json
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupChatScopeInfo -> MsgScope
toMsgScope GroupInfo
gInfo (GroupChatScopeInfo -> MsgScope)
-> Maybe GroupChatScopeInfo -> Maybe MsgScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupChatScopeInfo
chatScopeInfo) [SharedMsgId]
msgIds
          (NonEmpty (ChatMsgEvent 'Json)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (Either ChatError SndMessage), GroupSndResult))
-> Maybe (NonEmpty (ChatMsgEvent 'Json))
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages User
user GroupInfo
gInfo Maybe GroupChatScope
forall a. Maybe a
Nothing [GroupMember]
recipients) Maybe (NonEmpty (ChatMsgEvent 'Json))
events
          -- TODO delGroupChatItems sends deletion events too. Are they needed?
          User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
delGroupChatItems User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [CChatItem 'CTGroup]
items Bool
False
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [ChatItemDeletion] -> Bool -> Bool -> ChatResponse
CRChatItemsDeleted User
user [ChatItemDeletion]
deletions Bool
True Bool
False
    ChatType
CTLocal -> do
      (NoteFolder
nf, [CChatItem 'CTLocal]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (NoteFolder, [CChatItem 'CTLocal])
getCommandLocalChatItems User
user Int64
chatId NonEmpty Int64
itemIds
      User
-> NoteFolder
-> [CChatItem 'CTLocal]
-> Bool
-> Bool
-> CM ChatResponse
deleteLocalCIs User
user NoteFolder
nf [CChatItem 'CTLocal]
items Bool
True Bool
False
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    where
      assertDeletable :: forall c. ChatTypeI c => [CChatItem c] -> CM ()
      assertDeletable :: forall (c :: ChatType).
ChatTypeI c =>
[CChatItem c] -> ExceptT ChatError (ReaderT ChatController IO) ()
assertDeletable [CChatItem c]
items = do
        UTCTime
currentTs <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((CChatItem c -> Bool) -> [CChatItem c] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (UTCTime -> CChatItem c -> Bool
itemDeletable UTCTime
currentTs) [CChatItem c]
items) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidChatItemDelete
        where
          itemDeletable :: UTCTime -> CChatItem c -> Bool
          itemDeletable :: UTCTime -> CChatItem c -> Bool
itemDeletable UTCTime
currentTs (CChatItem SMsgDirection d
msgDir ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId, UTCTime
itemTs :: UTCTime
itemTs :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
itemTs, Maybe (CIDeleted c)
itemDeleted :: Maybe (CIDeleted c)
itemDeleted :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted}, CIContent d
content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d
content}) =
            case SMsgDirection d
msgDir of
              -- We check with a 6 hour margin compared to CIMeta deletable to account for deletion on the border
              SMsgDirection d
SMDSnd -> Maybe SharedMsgId -> Bool
forall a. Maybe a -> Bool
isJust Maybe SharedMsgId
itemSharedMsgId Bool -> Bool -> Bool
&& CIContent d
-> Maybe (CIDeleted c)
-> UTCTime
-> NominalDiffTime
-> UTCTime
-> Bool
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
CIContent d
-> Maybe (CIDeleted c)
-> UTCTime
-> NominalDiffTime
-> UTCTime
-> Bool
deletable' CIContent d
content Maybe (CIDeleted c)
itemDeleted UTCTime
itemTs (NominalDiffTime
nominalDay NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
6 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
3600) UTCTime
currentTs
              SMsgDirection d
SMDRcv -> Bool
False
      itemsMsgIds :: [CChatItem c] -> [SharedMsgId]
      itemsMsgIds :: forall (c :: ChatType). [CChatItem c] -> [SharedMsgId]
itemsMsgIds = (CChatItem c -> Maybe SharedMsgId)
-> [CChatItem c] -> [SharedMsgId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(CChatItem SMsgDirection d
_ ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}}) -> Maybe SharedMsgId
itemSharedMsgId)
  APIDeleteMemberChatItem Int64
gId NonEmpty Int64
itemIds -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"deleteChatItem" Int64
gId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    (GroupInfo
gInfo, [CChatItem 'CTGroup]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (GroupInfo, [CChatItem 'CTGroup])
getCommandGroupChatItems User
user Int64
gId NonEmpty Int64
itemIds
    -- TODO [knocking] check scope is Nothing for all items? (prohibit moderation in support chats?)
    [GroupMember]
ms <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
    let recipients :: [GroupMember]
recipients = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrent [GroupMember]
ms
    [ChatItemDeletion]
deletions <- User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> [CChatItem 'CTGroup]
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
delGroupChatItemsForMembers User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing [GroupMember]
recipients [CChatItem 'CTGroup]
items
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [ChatItemDeletion] -> Bool -> Bool -> ChatResponse
CRChatItemsDeleted User
user [ChatItemDeletion]
deletions Bool
True Bool
False
  APIArchiveReceivedReports Int64
gId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> (Connection -> ExceptT StoreError IO ChatResponse)
-> CM ChatResponse
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ChatResponse)
 -> CM ChatResponse)
-> (Connection -> ExceptT StoreError IO ChatResponse)
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
    GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId
    UTCTime
deleteTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    [Int64]
ciIds <- IO [Int64] -> ExceptT StoreError IO [Int64]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Int64] -> ExceptT StoreError IO [Int64])
-> IO [Int64] -> ExceptT StoreError IO [Int64]
forall a b. (a -> b) -> a -> b
$ Connection -> User -> GroupInfo -> UTCTime -> IO [Int64]
markReceivedGroupReportsDeleted Connection
db User
user GroupInfo
g UTCTime
deleteTs
    ChatResponse -> ExceptT StoreError IO ChatResponse
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> ExceptT StoreError IO ChatResponse)
-> ChatResponse -> ExceptT StoreError IO ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> [Int64]
-> Bool
-> Maybe GroupMember
-> ChatResponse
CRGroupChatItemsDeleted User
user GroupInfo
g [Int64]
ciIds Bool
True (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just (GroupMember -> Maybe GroupMember)
-> GroupMember -> Maybe GroupMember
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMember
membership GroupInfo
g)
  APIDeleteReceivedReports Int64
gId NonEmpty Int64
itemIds CIDeleteMode
mode -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"deleteReports" Int64
gId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    (GroupInfo
gInfo, [CChatItem 'CTGroup]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (GroupInfo, [CChatItem 'CTGroup])
getCommandGroupChatItems User
user Int64
gId NonEmpty Int64
itemIds
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((CChatItem 'CTGroup -> Bool) -> [CChatItem 'CTGroup] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CChatItem 'CTGroup -> Bool
forall {c :: ChatType}. CChatItem c -> Bool
isRcvReport [CChatItem 'CTGroup]
items) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"some items are not received reports"
    -- TODO [knocking] scope can be different for each item if reports are from different members
    -- TODO            (currently we pass Nothing as scope which is wrong)
    [ChatItemDeletion]
deletions <- case CIDeleteMode
mode of
      CIDeleteMode
CIDMInternal -> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Maybe GroupMember
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
deleteGroupCIs User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing [CChatItem 'CTGroup]
items Maybe GroupMember
forall a. Maybe a
Nothing (UTCTime
 -> ExceptT
      ChatError (ReaderT ChatController IO) [ChatItemDeletion])
-> ExceptT ChatError (ReaderT ChatController IO) UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      CIDeleteMode
CIDMInternalMark -> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Maybe GroupMember
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
markGroupCIsDeleted User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing [CChatItem 'CTGroup]
items Maybe GroupMember
forall a. Maybe a
Nothing (UTCTime
 -> ExceptT
      ChatError (ReaderT ChatController IO) [ChatItemDeletion])
-> ExceptT ChatError (ReaderT ChatController IO) UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      CIDeleteMode
CIDMBroadcast -> do
        [GroupMember]
ms <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupModerators Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
        let recipients :: [GroupMember]
recipients = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrent [GroupMember]
ms
        User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> [CChatItem 'CTGroup]
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
delGroupChatItemsForMembers User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing [GroupMember]
recipients [CChatItem 'CTGroup]
items
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [ChatItemDeletion] -> Bool -> Bool -> ChatResponse
CRChatItemsDeleted User
user [ChatItemDeletion]
deletions Bool
True Bool
False
    where
      isRcvReport :: CChatItem c -> Bool
isRcvReport = \case
        CChatItem SMsgDirection d
_ ChatItem {content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CIRcvMsgContent (MCReport {})} -> Bool
True
        CChatItem c
_ -> Bool
False
  APIChatItemReaction (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) Int64
itemId Bool
add MsgReaction
reaction -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
cType of
    ChatType
CTDirect ->
      Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"chatItemReaction" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
        (Connection
 -> ExceptT StoreError IO (Contact, CChatItem 'CTDirect))
-> CM (Contact, CChatItem 'CTDirect)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> (,) (Contact -> CChatItem 'CTDirect -> (Contact, CChatItem 'CTDirect))
-> ExceptT StoreError IO Contact
-> ExceptT
     StoreError
     IO
     (CChatItem 'CTDirect -> (Contact, CChatItem 'CTDirect))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId ExceptT
  StoreError
  IO
  (CChatItem 'CTDirect -> (Contact, CChatItem 'CTDirect))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
-> ExceptT StoreError IO (Contact, CChatItem 'CTDirect)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user Int64
chatId Int64
itemId) CM (Contact, CChatItem 'CTDirect)
-> ((Contact, CChatItem 'CTDirect) -> CM ChatResponse)
-> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          (Contact
ct, CChatItem SMsgDirection d
md ci :: ChatItem 'CTDirect d
ci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId = Just SharedMsgId
itemSharedMId}}) -> do
            Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SChatFeature 'CFReactions
-> (PrefEnabled -> Bool) -> Contact -> Bool
forall (f :: ChatFeature).
SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool
featureAllowed SChatFeature 'CFReactions
SCFReactions PrefEnabled -> Bool
forUser Contact
ct) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
              String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String
"feature not allowed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ChatFeature -> Text
chatFeatureNameText ChatFeature
CFReactions)
            Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ChatItem 'CTDirect d -> Bool
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Bool
ciReactionAllowed ChatItem 'CTDirect d
ci) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
              String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"reaction not allowed - chat item has no content"
            [MsgReaction]
rs <- (Connection -> IO [MsgReaction]) -> CM [MsgReaction]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [MsgReaction]) -> CM [MsgReaction])
-> (Connection -> IO [MsgReaction]) -> CM [MsgReaction]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Contact -> SharedMsgId -> Bool -> IO [MsgReaction]
getDirectReactions Connection
db Contact
ct SharedMsgId
itemSharedMId Bool
True
            [MsgReaction] -> ExceptT ChatError (ReaderT ChatController IO) ()
checkReactionAllowed [MsgReaction]
rs
            (SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId}, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall a b. (a -> b) -> a -> b
$ SharedMsgId
-> Maybe MemberId
-> Maybe MsgScope
-> MsgReaction
-> Bool
-> ChatMsgEvent 'Json
XMsgReact SharedMsgId
itemSharedMId Maybe MemberId
forall a. Maybe a
Nothing Maybe MsgScope
forall a. Maybe a
Nothing MsgReaction
reaction Bool
add
            UTCTime
createdAt <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            [CIReactionCount]
reactions <- (Connection -> IO [CIReactionCount]) -> CM [CIReactionCount]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIReactionCount]) -> CM [CIReactionCount])
-> (Connection -> IO [CIReactionCount]) -> CM [CIReactionCount]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
              Connection
-> Contact
-> SharedMsgId
-> Bool
-> MsgReaction
-> Bool
-> Int64
-> UTCTime
-> IO ()
setDirectReaction Connection
db Contact
ct SharedMsgId
itemSharedMId Bool
True MsgReaction
reaction Bool
add Int64
msgId UTCTime
createdAt
              IO [CIReactionCount] -> IO [CIReactionCount]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CIReactionCount] -> IO [CIReactionCount])
-> IO [CIReactionCount] -> IO [CIReactionCount]
forall a b. (a -> b) -> a -> b
$ Connection -> Contact -> SharedMsgId -> IO [CIReactionCount]
getDirectCIReactions Connection
db Contact
ct SharedMsgId
itemSharedMId
            let ci' :: CChatItem 'CTDirect
ci' = SMsgDirection d -> ChatItem 'CTDirect d -> CChatItem 'CTDirect
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
md ChatItem 'CTDirect d
ci {reactions}
                r :: ACIReaction
r = SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> CIReaction 'CTDirect 'MDSnd
-> ACIReaction
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> CIReaction c d -> ACIReaction
ACIReaction SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) (CIReaction 'CTDirect 'MDSnd -> ACIReaction)
-> CIReaction 'CTDirect 'MDSnd -> ACIReaction
forall a b. (a -> b) -> a -> b
$ CIDirection 'CTDirect 'MDSnd
-> CChatItem 'CTDirect
-> UTCTime
-> MsgReaction
-> CIReaction 'CTDirect 'MDSnd
forall (c :: ChatType) (d :: MsgDirection).
CIDirection c d
-> CChatItem c -> UTCTime -> MsgReaction -> CIReaction c d
CIReaction CIDirection 'CTDirect 'MDSnd
CIDirectSnd CChatItem 'CTDirect
ci' UTCTime
createdAt MsgReaction
reaction
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Bool -> ACIReaction -> ChatResponse
CRChatItemReaction User
user Bool
add ACIReaction
r
          (Contact, CChatItem 'CTDirect)
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"reaction not possible - no shared item ID"
    ChatType
CTGroup ->
      Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"chatItemReaction" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
        -- TODO [knocking] check chat item scope?
        (g :: GroupInfo
g@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership}, CChatItem SMsgDirection d
md ChatItem 'CTGroup d
ci) <- (Connection
 -> ExceptT StoreError IO (GroupInfo, CChatItem 'CTGroup))
-> CM (GroupInfo, CChatItem 'CTGroup)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (GroupInfo, CChatItem 'CTGroup))
 -> CM (GroupInfo, CChatItem 'CTGroup))
-> (Connection
    -> ExceptT StoreError IO (GroupInfo, CChatItem 'CTGroup))
-> CM (GroupInfo, CChatItem 'CTGroup)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
          (GroupInfo
g,) (CChatItem 'CTGroup -> (GroupInfo, CChatItem 'CTGroup))
-> ExceptT StoreError IO (CChatItem 'CTGroup)
-> ExceptT StoreError IO (GroupInfo, CChatItem 'CTGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
g Int64
itemId
        Maybe GroupChatScopeInfo
chatScopeInfo <- (GroupChatScope
 -> ExceptT
      ChatError (ReaderT ChatController IO) GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (VersionRangeChat
-> User
-> GroupChatScope
-> ExceptT ChatError (ReaderT ChatController IO) GroupChatScopeInfo
getChatScopeInfo VersionRangeChat
vr User
user) Maybe GroupChatScope
scope
        [GroupMember]
recipients <- VersionRangeChat
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Version ChatVersion
-> CM [GroupMember]
getGroupRecipients VersionRangeChat
vr User
user GroupInfo
g Maybe GroupChatScopeInfo
chatScopeInfo Version ChatVersion
groupKnockingVersion
        case ChatItem 'CTGroup d
ci of
          ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId = Just SharedMsgId
itemSharedMId}} -> do
            Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SGroupFeature 'GFReactions -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureNoRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureAllowed SGroupFeature 'GFReactions
SGFReactions GroupInfo
g) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
              String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String
"feature not allowed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ChatFeature -> Text
chatFeatureNameText ChatFeature
CFReactions)
            Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ChatItem 'CTGroup d -> Bool
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Bool
ciReactionAllowed ChatItem 'CTGroup d
ci) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
              String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"reaction not allowed - chat item has no content"
            let GroupMember {memberId :: GroupMember -> MemberId
memberId = MemberId
itemMemberId} = GroupInfo -> ChatItem 'CTGroup d -> GroupMember
forall (d :: MsgDirection).
GroupInfo -> ChatItem 'CTGroup d -> GroupMember
chatItemMember GroupInfo
g ChatItem 'CTGroup d
ci
            [MsgReaction]
rs <- (Connection -> IO [MsgReaction]) -> CM [MsgReaction]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [MsgReaction]) -> CM [MsgReaction])
-> (Connection -> IO [MsgReaction]) -> CM [MsgReaction]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> GroupInfo
-> GroupMember
-> MemberId
-> SharedMsgId
-> Bool
-> IO [MsgReaction]
getGroupReactions Connection
db GroupInfo
g GroupMember
membership MemberId
itemMemberId SharedMsgId
itemSharedMId Bool
True
            [MsgReaction] -> ExceptT ChatError (ReaderT ChatController IO) ()
checkReactionAllowed [MsgReaction]
rs
            SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId} <- User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent e
-> CM SndMessage
sendGroupMessage User
user GroupInfo
g Maybe GroupChatScope
scope [GroupMember]
recipients (SharedMsgId
-> Maybe MemberId
-> Maybe MsgScope
-> MsgReaction
-> Bool
-> ChatMsgEvent 'Json
XMsgReact SharedMsgId
itemSharedMId (MemberId -> Maybe MemberId
forall a. a -> Maybe a
Just MemberId
itemMemberId) (GroupInfo -> GroupChatScopeInfo -> MsgScope
toMsgScope GroupInfo
g (GroupChatScopeInfo -> MsgScope)
-> Maybe GroupChatScopeInfo -> Maybe MsgScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupChatScopeInfo
chatScopeInfo) MsgReaction
reaction Bool
add)
            UTCTime
createdAt <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            [CIReactionCount]
reactions <- (Connection -> IO [CIReactionCount]) -> CM [CIReactionCount]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIReactionCount]) -> CM [CIReactionCount])
-> (Connection -> IO [CIReactionCount]) -> CM [CIReactionCount]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
              Connection
-> GroupInfo
-> GroupMember
-> MemberId
-> SharedMsgId
-> Bool
-> MsgReaction
-> Bool
-> Int64
-> UTCTime
-> IO ()
setGroupReaction Connection
db GroupInfo
g GroupMember
membership MemberId
itemMemberId SharedMsgId
itemSharedMId Bool
True MsgReaction
reaction Bool
add Int64
msgId UTCTime
createdAt
              IO [CIReactionCount] -> IO [CIReactionCount]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CIReactionCount] -> IO [CIReactionCount])
-> IO [CIReactionCount] -> IO [CIReactionCount]
forall a b. (a -> b) -> a -> b
$ Connection
-> GroupInfo -> MemberId -> SharedMsgId -> IO [CIReactionCount]
getGroupCIReactions Connection
db GroupInfo
g MemberId
itemMemberId SharedMsgId
itemSharedMId
            let ci' :: CChatItem 'CTGroup
ci' = SMsgDirection d -> ChatItem 'CTGroup d -> CChatItem 'CTGroup
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
md ChatItem 'CTGroup d
ci {reactions}
                r :: ACIReaction
r = SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> CIReaction 'CTGroup 'MDSnd
-> ACIReaction
forall (c :: ChatType) (d :: MsgDirection).
ChatTypeI c =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> CIReaction c d -> ACIReaction
ACIReaction SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
g Maybe GroupChatScopeInfo
chatScopeInfo) (CIReaction 'CTGroup 'MDSnd -> ACIReaction)
-> CIReaction 'CTGroup 'MDSnd -> ACIReaction
forall a b. (a -> b) -> a -> b
$ CIDirection 'CTGroup 'MDSnd
-> CChatItem 'CTGroup
-> UTCTime
-> MsgReaction
-> CIReaction 'CTGroup 'MDSnd
forall (c :: ChatType) (d :: MsgDirection).
CIDirection c d
-> CChatItem c -> UTCTime -> MsgReaction -> CIReaction c d
CIReaction CIDirection 'CTGroup 'MDSnd
CIGroupSnd CChatItem 'CTGroup
ci' UTCTime
createdAt MsgReaction
reaction
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Bool -> ACIReaction -> ChatResponse
CRChatItemReaction User
user Bool
add ACIReaction
r
          ChatItem 'CTGroup d
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"invalid reaction"
    ChatType
CTLocal -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    where
      checkReactionAllowed :: [MsgReaction] -> ExceptT ChatError (ReaderT ChatController IO) ()
checkReactionAllowed [MsgReaction]
rs = do
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((MsgReaction
reaction MsgReaction -> [MsgReaction] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MsgReaction]
rs) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
add) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
          String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String
"reaction already " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if Bool
add then String
"added" else String
"removed"
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
add Bool -> Bool -> Bool
&& [MsgReaction] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MsgReaction]
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxMsgReactions) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
          String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"too many reactions"
  APIGetReactionMembers Int64
userId Int64
groupId Int64
itemId MsgReaction
reaction -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [MemberReaction]
memberReactions <- (Connection -> ExceptT StoreError IO [MemberReaction])
-> CM [MemberReaction]
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO [MemberReaction])
 -> CM [MemberReaction])
-> (Connection -> ExceptT StoreError IO [MemberReaction])
-> CM [MemberReaction]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      CChatItem SMsgDirection d
_ ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId = Just SharedMsgId
itemSharedMId}} <- Connection
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupChatItem Connection
db User
user Int64
groupId Int64
itemId
      IO [MemberReaction] -> ExceptT StoreError IO [MemberReaction]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MemberReaction] -> ExceptT StoreError IO [MemberReaction])
-> IO [MemberReaction] -> ExceptT StoreError IO [MemberReaction]
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat
-> User
-> Int64
-> SharedMsgId
-> MsgReaction
-> IO [MemberReaction]
getReactionMembers Connection
db VersionRangeChat
vr User
user Int64
groupId SharedMsgId
itemSharedMId MsgReaction
reaction
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [MemberReaction] -> ChatResponse
CRReactionMembers User
user [MemberReaction]
memberReactions
  -- TODO [knocking] forward from scope?
  APIPlanForwardChatItems (ChatRef ChatType
fromCType Int64
fromChatId Maybe GroupChatScope
_scope) NonEmpty Int64
itemIds -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
fromCType of
    ChatType
CTDirect -> User -> [CChatItem 'CTDirect] -> CM ChatResponse
forall (c :: ChatType). User -> [CChatItem c] -> CM ChatResponse
planForward User
user ([CChatItem 'CTDirect] -> CM ChatResponse)
-> ((Contact, [CChatItem 'CTDirect]) -> [CChatItem 'CTDirect])
-> (Contact, [CChatItem 'CTDirect])
-> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Contact, [CChatItem 'CTDirect]) -> [CChatItem 'CTDirect]
forall a b. (a, b) -> b
snd ((Contact, [CChatItem 'CTDirect]) -> CM ChatResponse)
-> CM (Contact, [CChatItem 'CTDirect]) -> CM ChatResponse
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< User
-> Int64 -> NonEmpty Int64 -> CM (Contact, [CChatItem 'CTDirect])
getCommandDirectChatItems User
user Int64
fromChatId NonEmpty Int64
itemIds
    ChatType
CTGroup -> User -> [CChatItem 'CTGroup] -> CM ChatResponse
forall (c :: ChatType). User -> [CChatItem c] -> CM ChatResponse
planForward User
user ([CChatItem 'CTGroup] -> CM ChatResponse)
-> ((GroupInfo, [CChatItem 'CTGroup]) -> [CChatItem 'CTGroup])
-> (GroupInfo, [CChatItem 'CTGroup])
-> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupInfo, [CChatItem 'CTGroup]) -> [CChatItem 'CTGroup]
forall a b. (a, b) -> b
snd ((GroupInfo, [CChatItem 'CTGroup]) -> CM ChatResponse)
-> CM (GroupInfo, [CChatItem 'CTGroup]) -> CM ChatResponse
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< User
-> Int64 -> NonEmpty Int64 -> CM (GroupInfo, [CChatItem 'CTGroup])
getCommandGroupChatItems User
user Int64
fromChatId NonEmpty Int64
itemIds
    ChatType
CTLocal -> User -> [CChatItem 'CTLocal] -> CM ChatResponse
forall (c :: ChatType). User -> [CChatItem c] -> CM ChatResponse
planForward User
user ([CChatItem 'CTLocal] -> CM ChatResponse)
-> ((NoteFolder, [CChatItem 'CTLocal]) -> [CChatItem 'CTLocal])
-> (NoteFolder, [CChatItem 'CTLocal])
-> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoteFolder, [CChatItem 'CTLocal]) -> [CChatItem 'CTLocal]
forall a b. (a, b) -> b
snd ((NoteFolder, [CChatItem 'CTLocal]) -> CM ChatResponse)
-> CM (NoteFolder, [CChatItem 'CTLocal]) -> CM ChatResponse
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< User
-> Int64 -> NonEmpty Int64 -> CM (NoteFolder, [CChatItem 'CTLocal])
getCommandLocalChatItems User
user Int64
fromChatId NonEmpty Int64
itemIds
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    where
      planForward :: User -> [CChatItem c] -> CM ChatResponse
      planForward :: forall (c :: ChatType). User -> [CChatItem c] -> CM ChatResponse
planForward User
user [CChatItem c]
items = do
        ([Maybe Int64]
itemIds', [Maybe ForwardFileError]
forwardErrors) <- [(Maybe Int64, Maybe ForwardFileError)]
-> ([Maybe Int64], [Maybe ForwardFileError])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe Int64, Maybe ForwardFileError)]
 -> ([Maybe Int64], [Maybe ForwardFileError]))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [(Maybe Int64, Maybe ForwardFileError)]
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([Maybe Int64], [Maybe ForwardFileError])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CChatItem c
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe Int64, Maybe ForwardFileError))
-> [CChatItem c]
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [(Maybe Int64, Maybe ForwardFileError)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CChatItem c
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall (c :: ChatType).
CChatItem c
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
planItemForward [CChatItem c]
items
        let forwardConfirmation :: Maybe ForwardConfirmation
forwardConfirmation = case [Maybe ForwardFileError] -> [ForwardFileError]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ForwardFileError]
forwardErrors of
              [] -> Maybe ForwardConfirmation
forall a. Maybe a
Nothing
              [ForwardFileError]
errs -> ForwardConfirmation -> Maybe ForwardConfirmation
forall a. a -> Maybe a
Just (ForwardConfirmation -> Maybe ForwardConfirmation)
-> ForwardConfirmation -> Maybe ForwardConfirmation
forall a b. (a -> b) -> a -> b
$ case ForwardFileError
mainErr of
                FFENotAccepted Int64
_ -> [Int64] -> ForwardConfirmation
FCFilesNotAccepted [Int64]
fileIds
                ForwardFileError
FFEInProgress -> Int -> ForwardConfirmation
FCFilesInProgress Int
filesCount
                ForwardFileError
FFEMissing -> Int -> ForwardConfirmation
FCFilesMissing Int
filesCount
                ForwardFileError
FFEFailed -> Int -> ForwardConfirmation
FCFilesFailed Int
filesCount
                where
                  mainErr :: ForwardFileError
mainErr = [ForwardFileError] -> ForwardFileError
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ForwardFileError]
errs
                  fileIds :: [Int64]
fileIds = [Maybe Int64] -> [Int64]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Int64] -> [Int64]) -> [Maybe Int64] -> [Int64]
forall a b. (a -> b) -> a -> b
$ (ForwardFileError -> Maybe Int64)
-> [ForwardFileError] -> [Maybe Int64]
forall a b. (a -> b) -> [a] -> [b]
map (\case FFENotAccepted Int64
ftId -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
ftId; ForwardFileError
_ -> Maybe Int64
forall a. Maybe a
Nothing) [ForwardFileError]
errs
                  filesCount :: Int
filesCount = [ForwardFileError] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ForwardFileError] -> Int) -> [ForwardFileError] -> Int
forall a b. (a -> b) -> a -> b
$ (ForwardFileError -> Bool)
-> [ForwardFileError] -> [ForwardFileError]
forall a. (a -> Bool) -> [a] -> [a]
filter (ForwardFileError
mainErr ForwardFileError -> ForwardFileError -> Bool
forall a. Eq a => a -> a -> Bool
==) [ForwardFileError]
errs
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRForwardPlan {User
user :: User
user :: User
user, itemsCount :: Int
itemsCount = NonEmpty Int64 -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Int64
itemIds, chatItemIds :: [Int64]
chatItemIds = [Maybe Int64] -> [Int64]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int64]
itemIds', Maybe ForwardConfirmation
forwardConfirmation :: Maybe ForwardConfirmation
forwardConfirmation :: Maybe ForwardConfirmation
forwardConfirmation}
        where
          planItemForward :: CChatItem c -> CM (Maybe ChatItemId, Maybe ForwardFileError)
          planItemForward :: forall (c :: ChatType).
CChatItem c
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
planItemForward (CChatItem SMsgDirection d
_ ChatItem c d
ci) = ChatItem c d -> CM (Maybe MsgContent)
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CM (Maybe MsgContent)
forwardMsgContent ChatItem c d
ci CM (Maybe MsgContent)
-> (Maybe MsgContent
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe Int64, Maybe ForwardFileError))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Maybe Int64, Maybe ForwardFileError)
-> (MsgContent
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe Int64, Maybe ForwardFileError))
-> Maybe MsgContent
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Int64
forall a. Maybe a
Nothing, Maybe ForwardFileError
forall a. Maybe a
Nothing)) (ChatItem c d
-> MsgContent
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> MsgContent
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forwardContentPlan ChatItem c d
ci)
          forwardContentPlan :: ChatItem c d -> MsgContent -> CM (Maybe ChatItemId, Maybe ForwardFileError)
          forwardContentPlan :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> MsgContent
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forwardContentPlan ChatItem {Maybe (CIFile d)
file :: Maybe (CIFile d)
file :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe (CIFile d)
file, meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Int64
itemId :: Int64
itemId :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Int64
itemId}} MsgContent
mc = case Maybe (CIFile d)
file of
            Maybe (CIFile d)
Nothing -> (Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
itemId, Maybe ForwardFileError
forall a. Maybe a
Nothing)
            Just CIFile {Int64
fileId :: Int64
fileId :: forall (d :: MsgDirection). CIFile d -> Int64
fileId, CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus :: forall (d :: MsgDirection). CIFile d -> CIFileStatus d
fileStatus, Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource :: forall (d :: MsgDirection). CIFile d -> Maybe CryptoFile
fileSource} -> case Int64 -> CIFileStatus d -> Maybe ForwardFileError
forall (d :: MsgDirection).
Int64 -> CIFileStatus d -> Maybe ForwardFileError
ciFileForwardError Int64
fileId CIFileStatus d
fileStatus of
              Just ForwardFileError
err -> (Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Int64, Maybe ForwardFileError)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe Int64, Maybe ForwardFileError))
-> (Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a b. (a -> b) -> a -> b
$ ForwardFileError -> (Maybe Int64, Maybe ForwardFileError)
itemIdWithoutFile ForwardFileError
err
              Maybe ForwardFileError
Nothing -> case Maybe CryptoFile
fileSource of
                Just CryptoFile {String
filePath :: String
filePath :: CryptoFile -> String
filePath} -> do
                  Bool
exists <- String -> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist (String -> ExceptT ChatError (ReaderT ChatController IO) Bool)
-> ExceptT ChatError (ReaderT ChatController IO) String
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> ReaderT ChatController IO String
toFSFilePath String
filePath)
                  (Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Int64, Maybe ForwardFileError)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe Int64, Maybe ForwardFileError))
-> (Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a b. (a -> b) -> a -> b
$ if Bool
exists then (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
itemId, Maybe ForwardFileError
forall a. Maybe a
Nothing) else ForwardFileError -> (Maybe Int64, Maybe ForwardFileError)
itemIdWithoutFile ForwardFileError
FFEMissing
                Maybe CryptoFile
Nothing -> (Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Maybe Int64, Maybe ForwardFileError)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe Int64, Maybe ForwardFileError))
-> (Maybe Int64, Maybe ForwardFileError)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe Int64, Maybe ForwardFileError)
forall a b. (a -> b) -> a -> b
$ ForwardFileError -> (Maybe Int64, Maybe ForwardFileError)
itemIdWithoutFile ForwardFileError
FFEMissing
            where
              itemIdWithoutFile :: ForwardFileError -> (Maybe Int64, Maybe ForwardFileError)
itemIdWithoutFile ForwardFileError
err = (if Bool
hasContent then Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
itemId else Maybe Int64
forall a. Maybe a
Nothing, ForwardFileError -> Maybe ForwardFileError
forall a. a -> Maybe a
Just ForwardFileError
err)
              hasContent :: Bool
hasContent = case MsgContent
mc of
                MCText Text
_ -> Bool
True
                MCLink {} -> Bool
True
                MCImage {} -> Bool
True
                MCVideo {Text
text :: Text
text :: MsgContent -> Text
text} -> Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
""
                MCVoice {Text
text :: MsgContent -> Text
text :: Text
text} -> Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
""
                MCFile Text
t -> Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
""
                MCReport {} -> Bool
True
                MCChat {} -> Bool
True
                MCUnknown {} -> Bool
True
  -- TODO [knocking] forward from / to scope
  APIForwardChatItems toChat :: ChatRef
toChat@(ChatRef ChatType
toCType Int64
toChatId Maybe GroupChatScope
toScope) fromChat :: ChatRef
fromChat@(ChatRef ChatType
fromCType Int64
fromChatId Maybe GroupChatScope
_fromScope) NonEmpty Int64
itemIds Maybe Int
itemTTL -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
toCType of
    ChatType
CTDirect -> do
      [ComposedMessageReq]
cmrs <- User -> CM [ComposedMessageReq]
prepareForward User
user
      case [ComposedMessageReq] -> Maybe (NonEmpty ComposedMessageReq)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [ComposedMessageReq]
cmrs of
        Just NonEmpty ComposedMessageReq
cmrs' ->
          Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"forwardChatItem, to contact" Int64
toChatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
            User
-> Int64
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendContactContentMessages User
user Int64
toChatId Bool
False Maybe Int
itemTTL NonEmpty ComposedMessageReq
cmrs'
        Maybe (NonEmpty ComposedMessageReq)
Nothing -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatResponse
CRNewChatItems User
user []
    ChatType
CTGroup -> do
      [ComposedMessageReq]
cmrs <- User -> CM [ComposedMessageReq]
prepareForward User
user
      case [ComposedMessageReq] -> Maybe (NonEmpty ComposedMessageReq)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [ComposedMessageReq]
cmrs of
        Just NonEmpty ComposedMessageReq
cmrs' ->
          Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"forwardChatItem, to group" Int64
toChatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
            GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
toChatId
            User
-> GroupInfo
-> Maybe GroupChatScope
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendGroupContentMessages User
user GroupInfo
gInfo Maybe GroupChatScope
toScope Bool
False Maybe Int
itemTTL NonEmpty ComposedMessageReq
cmrs'
        Maybe (NonEmpty ComposedMessageReq)
Nothing -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatResponse
CRNewChatItems User
user []
    ChatType
CTLocal -> do
      [ComposedMessageReq]
cmrs <- User -> CM [ComposedMessageReq]
prepareForward User
user
      case [ComposedMessageReq] -> Maybe (NonEmpty ComposedMessageReq)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [ComposedMessageReq]
cmrs of
        Just NonEmpty ComposedMessageReq
cmrs' ->
          User -> Int64 -> NonEmpty ComposedMessageReq -> CM ChatResponse
createNoteFolderContentItems User
user Int64
toChatId NonEmpty ComposedMessageReq
cmrs'
        Maybe (NonEmpty ComposedMessageReq)
Nothing -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatResponse
CRNewChatItems User
user []
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    where
      prepareForward :: User -> CM [ComposedMessageReq]
      prepareForward :: User -> CM [ComposedMessageReq]
prepareForward User
user = case ChatType
fromCType of
        ChatType
CTDirect -> Text -> Int64 -> CM [ComposedMessageReq] -> CM [ComposedMessageReq]
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"forwardChatItem, from contact" Int64
fromChatId (CM [ComposedMessageReq] -> CM [ComposedMessageReq])
-> CM [ComposedMessageReq] -> CM [ComposedMessageReq]
forall a b. (a -> b) -> a -> b
$ do
          (Contact
ct, [CChatItem 'CTDirect]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (Contact, [CChatItem 'CTDirect])
getCommandDirectChatItems User
user Int64
fromChatId NonEmpty Int64
itemIds
          [Maybe ComposedMessageReq] -> [ComposedMessageReq]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ComposedMessageReq] -> [ComposedMessageReq])
-> ExceptT
     ChatError (ReaderT ChatController IO) [Maybe ComposedMessageReq]
-> CM [ComposedMessageReq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CChatItem 'CTDirect
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe ComposedMessageReq))
-> [CChatItem 'CTDirect]
-> ExceptT
     ChatError (ReaderT ChatController IO) [Maybe ComposedMessageReq]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CChatItem 'CTDirect
ci -> Contact
-> CChatItem 'CTDirect
-> (MsgContent, Maybe CryptoFile)
-> ComposedMessageReq
ciComposeMsgReq Contact
ct CChatItem 'CTDirect
ci ((MsgContent, Maybe CryptoFile) -> ComposedMessageReq)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ComposedMessageReq)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> CChatItem 'CTDirect
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall (c :: ChatType).
CChatItem c
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
prepareMsgReq CChatItem 'CTDirect
ci) [CChatItem 'CTDirect]
items
          where
            ciComposeMsgReq :: Contact -> CChatItem 'CTDirect -> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
            ciComposeMsgReq :: Contact
-> CChatItem 'CTDirect
-> (MsgContent, Maybe CryptoFile)
-> ComposedMessageReq
ciComposeMsgReq Contact
ct (CChatItem SMsgDirection d
md ChatItem 'CTDirect d
ci) (MsgContent
mc', Maybe CryptoFile
file) =
              let itemId :: Int64
itemId = ChatItem 'CTDirect d -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem 'CTDirect d
ci
                  ciff :: Maybe CIForwardedFrom
ciff = ChatItem 'CTDirect d
-> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forwardCIFF ChatItem 'CTDirect d
ci (Maybe CIForwardedFrom -> Maybe CIForwardedFrom)
-> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forall a b. (a -> b) -> a -> b
$ CIForwardedFrom -> Maybe CIForwardedFrom
forall a. a -> Maybe a
Just (Text
-> MsgDirection -> Maybe Int64 -> Maybe Int64 -> CIForwardedFrom
CIFFContact (Contact -> Text
forwardName Contact
ct) (SMsgDirection d -> MsgDirection
forall (d :: MsgDirection). SMsgDirection d -> MsgDirection
toMsgDirection SMsgDirection d
md) (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
fromChatId) (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
itemId))
               in (Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage Maybe CryptoFile
file MsgContent
mc', Maybe CIForwardedFrom
ciff, MsgContent -> (Text, Maybe MarkdownList)
msgContentTexts MsgContent
mc', Map Text CIMention
forall k a. Map k a
M.empty)
              where
                forwardName :: Contact -> ContactName
                forwardName :: Contact -> Text
forwardName Contact {profile :: Contact -> LocalProfile
profile = LocalProfile {Text
displayName :: Text
displayName :: LocalProfile -> Text
displayName, Text
localAlias :: Text
localAlias :: LocalProfile -> Text
localAlias}}
                  | Text
localAlias Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" = Text
localAlias
                  | Bool
otherwise = Text
displayName
        -- TODO [knocking] from scope?
        ChatType
CTGroup -> Text -> Int64 -> CM [ComposedMessageReq] -> CM [ComposedMessageReq]
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"forwardChatItem, from group" Int64
fromChatId (CM [ComposedMessageReq] -> CM [ComposedMessageReq])
-> CM [ComposedMessageReq] -> CM [ComposedMessageReq]
forall a b. (a -> b) -> a -> b
$ do
          (GroupInfo
gInfo, [CChatItem 'CTGroup]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (GroupInfo, [CChatItem 'CTGroup])
getCommandGroupChatItems User
user Int64
fromChatId NonEmpty Int64
itemIds
          [Maybe ComposedMessageReq] -> [ComposedMessageReq]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ComposedMessageReq] -> [ComposedMessageReq])
-> ExceptT
     ChatError (ReaderT ChatController IO) [Maybe ComposedMessageReq]
-> CM [ComposedMessageReq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CChatItem 'CTGroup
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe ComposedMessageReq))
-> [CChatItem 'CTGroup]
-> ExceptT
     ChatError (ReaderT ChatController IO) [Maybe ComposedMessageReq]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CChatItem 'CTGroup
ci -> GroupInfo
-> CChatItem 'CTGroup
-> (MsgContent, Maybe CryptoFile)
-> ComposedMessageReq
ciComposeMsgReq GroupInfo
gInfo CChatItem 'CTGroup
ci ((MsgContent, Maybe CryptoFile) -> ComposedMessageReq)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ComposedMessageReq)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> CChatItem 'CTGroup
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall (c :: ChatType).
CChatItem c
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
prepareMsgReq CChatItem 'CTGroup
ci) [CChatItem 'CTGroup]
items
          where
            ciComposeMsgReq :: GroupInfo -> CChatItem 'CTGroup -> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
            ciComposeMsgReq :: GroupInfo
-> CChatItem 'CTGroup
-> (MsgContent, Maybe CryptoFile)
-> ComposedMessageReq
ciComposeMsgReq GroupInfo
gInfo (CChatItem SMsgDirection d
md ci :: ChatItem 'CTGroup d
ci@ChatItem {Map Text CIMention
mentions :: Map Text CIMention
mentions :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Map Text CIMention
mentions, Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe MarkdownList
formattedText}) (MsgContent
mc, Maybe CryptoFile
file) = do
              let itemId :: Int64
itemId = ChatItem 'CTGroup d -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem 'CTGroup d
ci
                  ciff :: Maybe CIForwardedFrom
ciff = ChatItem 'CTGroup d
-> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forwardCIFF ChatItem 'CTGroup d
ci (Maybe CIForwardedFrom -> Maybe CIForwardedFrom)
-> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forall a b. (a -> b) -> a -> b
$ CIForwardedFrom -> Maybe CIForwardedFrom
forall a. a -> Maybe a
Just (Text
-> MsgDirection -> Maybe Int64 -> Maybe Int64 -> CIForwardedFrom
CIFFGroup (GroupInfo -> Text
forwardName GroupInfo
gInfo) (SMsgDirection d -> MsgDirection
forall (d :: MsgDirection). SMsgDirection d -> MsgDirection
toMsgDirection SMsgDirection d
md) (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
fromChatId) (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
itemId))
                  -- updates text to reflect current mentioned member names
                  (MsgContent
mc', Maybe MarkdownList
_, Map Text CIMention
mentions') = MsgContent
-> Maybe MarkdownList
-> Map Text CIMention
-> (MsgContent, Maybe MarkdownList, Map Text CIMention)
updatedMentionNames MsgContent
mc Maybe MarkdownList
formattedText Map Text CIMention
mentions
                  -- only includes mentions when forwarding to the same group
                  ciMentions :: Map Text CIMention
ciMentions = if ChatRef
toChat ChatRef -> ChatRef -> Bool
forall a. Eq a => a -> a -> Bool
== ChatRef
fromChat then Map Text CIMention
mentions' else Map Text CIMention
forall k a. Map k a
M.empty
                  -- no need to have mentions in ComposedMessage, they are in ciMentions
               in (Maybe CryptoFile
-> Maybe Int64 -> MsgContent -> Map Text Int64 -> ComposedMessage
ComposedMessage Maybe CryptoFile
file Maybe Int64
forall a. Maybe a
Nothing MsgContent
mc' Map Text Int64
forall k a. Map k a
M.empty, Maybe CIForwardedFrom
ciff, MsgContent -> (Text, Maybe MarkdownList)
msgContentTexts MsgContent
mc', Map Text CIMention
ciMentions)
              where
                forwardName :: GroupInfo -> ContactName
                forwardName :: GroupInfo -> Text
forwardName GroupInfo {groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile {Text
displayName :: Text
displayName :: GroupProfile -> Text
displayName}} = Text
displayName
        ChatType
CTLocal -> do
          (NoteFolder
_, [CChatItem 'CTLocal]
items) <- User
-> Int64 -> NonEmpty Int64 -> CM (NoteFolder, [CChatItem 'CTLocal])
getCommandLocalChatItems User
user Int64
fromChatId NonEmpty Int64
itemIds
          [Maybe ComposedMessageReq] -> [ComposedMessageReq]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ComposedMessageReq] -> [ComposedMessageReq])
-> ExceptT
     ChatError (ReaderT ChatController IO) [Maybe ComposedMessageReq]
-> CM [ComposedMessageReq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CChatItem 'CTLocal
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe ComposedMessageReq))
-> [CChatItem 'CTLocal]
-> ExceptT
     ChatError (ReaderT ChatController IO) [Maybe ComposedMessageReq]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\CChatItem 'CTLocal
ci -> CChatItem 'CTLocal
-> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
ciComposeMsgReq CChatItem 'CTLocal
ci ((MsgContent, Maybe CryptoFile) -> ComposedMessageReq)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ComposedMessageReq)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> CChatItem 'CTLocal
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall (c :: ChatType).
CChatItem c
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
prepareMsgReq CChatItem 'CTLocal
ci) [CChatItem 'CTLocal]
items
          where
            ciComposeMsgReq :: CChatItem 'CTLocal -> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
            ciComposeMsgReq :: CChatItem 'CTLocal
-> (MsgContent, Maybe CryptoFile) -> ComposedMessageReq
ciComposeMsgReq (CChatItem SMsgDirection d
_ ChatItem 'CTLocal d
ci) (MsgContent
mc', Maybe CryptoFile
file) =
              let ciff :: Maybe CIForwardedFrom
ciff = ChatItem 'CTLocal d
-> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forwardCIFF ChatItem 'CTLocal d
ci Maybe CIForwardedFrom
forall a. Maybe a
Nothing
               in (Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage Maybe CryptoFile
file MsgContent
mc', Maybe CIForwardedFrom
ciff, MsgContent -> (Text, Maybe MarkdownList)
msgContentTexts MsgContent
mc', Map Text CIMention
forall k a. Map k a
M.empty)
        ChatType
CTContactRequest -> String -> CM [ComposedMessageReq]
forall a. String -> CM a
throwCmdError String
"not supported"
        ChatType
CTContactConnection -> String -> CM [ComposedMessageReq]
forall a. String -> CM a
throwCmdError String
"not supported"
        where
          prepareMsgReq :: CChatItem c -> CM (Maybe (MsgContent, Maybe CryptoFile))
          prepareMsgReq :: forall (c :: ChatType).
CChatItem c
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
prepareMsgReq (CChatItem SMsgDirection d
_ ChatItem c d
ci) = ChatItem c d -> CM (Maybe MsgContent)
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CM (Maybe MsgContent)
forwardMsgContent ChatItem c d
ci CM (Maybe MsgContent)
-> (MsgContent
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe (MsgContent, Maybe CryptoFile)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= ChatItem c d
-> MsgContent
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> MsgContent
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forwardContent ChatItem c d
ci
          forwardCIFF :: ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
          forwardCIFF :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe CIForwardedFrom -> Maybe CIForwardedFrom
forwardCIFF ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe CIForwardedFrom
itemForwarded :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe CIForwardedFrom
itemForwarded :: Maybe CIForwardedFrom
itemForwarded}} Maybe CIForwardedFrom
ciff = case Maybe CIForwardedFrom
itemForwarded of
            Maybe CIForwardedFrom
Nothing -> Maybe CIForwardedFrom
ciff
            Just CIForwardedFrom
CIFFUnknown -> Maybe CIForwardedFrom
ciff
            Just CIForwardedFrom
prevCIFF -> CIForwardedFrom -> Maybe CIForwardedFrom
forall a. a -> Maybe a
Just CIForwardedFrom
prevCIFF
          forwardContent :: ChatItem c d -> MsgContent -> CM (Maybe (MsgContent, Maybe CryptoFile))
          forwardContent :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> MsgContent
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forwardContent ChatItem {Maybe (CIFile d)
file :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe (CIFile d)
file :: Maybe (CIFile d)
file} MsgContent
mc = case Maybe (CIFile d)
file of
            Maybe (CIFile d)
Nothing -> Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MsgContent, Maybe CryptoFile)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe (MsgContent, Maybe CryptoFile)))
-> Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a b. (a -> b) -> a -> b
$ (MsgContent, Maybe CryptoFile)
-> Maybe (MsgContent, Maybe CryptoFile)
forall a. a -> Maybe a
Just (MsgContent
mc, Maybe CryptoFile
forall a. Maybe a
Nothing)
            Just CIFile {String
fileName :: String
fileName :: forall (d :: MsgDirection). CIFile d -> String
fileName, CIFileStatus d
fileStatus :: forall (d :: MsgDirection). CIFile d -> CIFileStatus d
fileStatus :: CIFileStatus d
fileStatus, fileSource :: forall (d :: MsgDirection). CIFile d -> Maybe CryptoFile
fileSource = Just fromCF :: CryptoFile
fromCF@CryptoFile {String
filePath :: CryptoFile -> String
filePath :: String
filePath}}
              | CIFileStatus d -> Bool
forall (d :: MsgDirection). CIFileStatus d -> Bool
ciFileLoaded CIFileStatus d
fileStatus ->
                  (ChatController -> TVar (Maybe String)) -> CM (Maybe String)
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar (Maybe String)
filesFolder CM (Maybe String)
-> (Maybe String
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe (MsgContent, Maybe CryptoFile)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe String
Nothing ->
                      ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist String
filePath) (Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MsgContent, Maybe CryptoFile)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe (MsgContent, Maybe CryptoFile)))
-> Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a b. (a -> b) -> a -> b
$ (MsgContent, Maybe CryptoFile)
-> Maybe (MsgContent, Maybe CryptoFile)
forall a. a -> Maybe a
Just (MsgContent
mc, CryptoFile -> Maybe CryptoFile
forall a. a -> Maybe a
Just CryptoFile
fromCF)) (Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MsgContent, Maybe CryptoFile)
contentWithoutFile)
                    Just String
filesFolder -> do
                      let fsFromPath :: String
fsFromPath = String
filesFolder String -> String -> String
</> String
filePath
                      ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
                        (String -> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist String
fsFromPath)
                        ( do
                            String
newFileName <- IO String -> ExceptT ChatError (ReaderT ChatController IO) String
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT ChatError (ReaderT ChatController IO) String)
-> IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall a b. (a -> b) -> a -> b
$ IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
fileName) (String -> String -> IO String
forall {m :: * -> *}. MonadIO m => String -> String -> m String
generateNewFileName String
fileName) (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$ MsgContent -> Maybe String
mediaFilePrefix MsgContent
mc
                            String
fsNewPath <- IO String -> ExceptT ChatError (ReaderT ChatController IO) String
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ExceptT ChatError (ReaderT ChatController IO) String)
-> IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall a b. (a -> b) -> a -> b
$ String
filesFolder String -> String -> IO String
`uniqueCombine` String
newFileName
                            IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
B.writeFile String
fsNewPath ByteString
"" -- create empty file
                            Bool
encrypt <- (ChatController -> TVar Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar Bool
encryptLocalFiles
                            Maybe CryptoFileArgs
cfArgs <- if Bool
encrypt then CryptoFileArgs -> Maybe CryptoFileArgs
forall a. a -> Maybe a
Just (CryptoFileArgs -> Maybe CryptoFileArgs)
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (STM CryptoFileArgs
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM CryptoFileArgs
 -> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs)
-> (TVar ChaChaDRG -> STM CryptoFileArgs)
-> TVar ChaChaDRG
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar ChaChaDRG -> STM CryptoFileArgs
CF.randomArgs (TVar ChaChaDRG
 -> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random) else Maybe CryptoFileArgs
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe CryptoFileArgs)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CryptoFileArgs
forall a. Maybe a
Nothing
                            let toCF :: CryptoFile
toCF = String -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile String
fsNewPath Maybe CryptoFileArgs
cfArgs
                            -- to keep forwarded file in case original is deleted
                            IO (Either ChatError ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) e a.
(MonadIO m, MonadError e m) =>
IO (Either e a) -> m a
liftIOEither (IO (Either ChatError ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> IO (Either ChatError ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ExceptT ChatError IO () -> IO (Either ChatError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError IO () -> IO (Either ChatError ()))
-> ExceptT ChatError IO () -> IO (Either ChatError ())
forall a b. (a -> b) -> a -> b
$ (FTCryptoError -> ChatError)
-> ExceptT FTCryptoError IO () -> ExceptT ChatError IO ()
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (ChatErrorType -> ChatError
ChatError (ChatErrorType -> ChatError)
-> (FTCryptoError -> ChatErrorType) -> FTCryptoError -> ChatError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ChatErrorType
CEInternalError (String -> ChatErrorType)
-> (FTCryptoError -> String) -> FTCryptoError -> ChatErrorType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FTCryptoError -> String
forall a. Show a => a -> String
show) (ExceptT FTCryptoError IO () -> ExceptT ChatError IO ())
-> ExceptT FTCryptoError IO () -> ExceptT ChatError IO ()
forall a b. (a -> b) -> a -> b
$ CryptoFile -> CryptoFile -> ExceptT FTCryptoError IO ()
copyCryptoFile (CryptoFile
fromCF {filePath = fsFromPath} :: CryptoFile) CryptoFile
toCF
                            Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (MsgContent, Maybe CryptoFile)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe (MsgContent, Maybe CryptoFile)))
-> Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a b. (a -> b) -> a -> b
$ (MsgContent, Maybe CryptoFile)
-> Maybe (MsgContent, Maybe CryptoFile)
forall a. a -> Maybe a
Just (MsgContent
mc, CryptoFile -> Maybe CryptoFile
forall a. a -> Maybe a
Just (CryptoFile
toCF {filePath = takeFileName fsNewPath} :: CryptoFile))
                        )
                        (Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MsgContent, Maybe CryptoFile)
contentWithoutFile)
            Maybe (CIFile d)
_ -> Maybe (MsgContent, Maybe CryptoFile)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (MsgContent, Maybe CryptoFile))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (MsgContent, Maybe CryptoFile)
contentWithoutFile
            where
              contentWithoutFile :: Maybe (MsgContent, Maybe CryptoFile)
contentWithoutFile = case MsgContent
mc of
                MCImage {} -> (MsgContent, Maybe CryptoFile)
-> Maybe (MsgContent, Maybe CryptoFile)
forall a. a -> Maybe a
Just (MsgContent
mc, Maybe CryptoFile
forall a. Maybe a
Nothing)
                MCLink {} -> (MsgContent, Maybe CryptoFile)
-> Maybe (MsgContent, Maybe CryptoFile)
forall a. a -> Maybe a
Just (MsgContent
mc, Maybe CryptoFile
forall a. Maybe a
Nothing)
                MsgContent
_ | Text
contentText Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" -> (MsgContent, Maybe CryptoFile)
-> Maybe (MsgContent, Maybe CryptoFile)
forall a. a -> Maybe a
Just (Text -> MsgContent
MCText Text
contentText, Maybe CryptoFile
forall a. Maybe a
Nothing)
                MsgContent
_ -> Maybe (MsgContent, Maybe CryptoFile)
forall a. Maybe a
Nothing
              contentText :: Text
contentText = MsgContent -> Text
msgContentText MsgContent
mc
          copyCryptoFile :: CryptoFile -> CryptoFile -> ExceptT CF.FTCryptoError IO ()
          copyCryptoFile :: CryptoFile -> CryptoFile -> ExceptT FTCryptoError IO ()
copyCryptoFile fromCF :: CryptoFile
fromCF@CryptoFile {filePath :: CryptoFile -> String
filePath = String
fsFromPath, cryptoArgs :: CryptoFile -> Maybe CryptoFileArgs
cryptoArgs = Maybe CryptoFileArgs
fromArgs} toCF :: CryptoFile
toCF@CryptoFile {cryptoArgs :: CryptoFile -> Maybe CryptoFileArgs
cryptoArgs = Maybe CryptoFileArgs
toArgs} = do
            Integer
fromSizeFull <- String -> ExceptT FTCryptoError IO Integer
forall (m :: * -> *). MonadIO m => String -> m Integer
getFileSize String
fsFromPath
            let fromSize :: Integer
fromSize = Integer
fromSizeFull Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
-> (CryptoFileArgs -> Integer) -> Maybe CryptoFileArgs -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (Integer -> CryptoFileArgs -> Integer
forall a b. a -> b -> a
const (Integer -> CryptoFileArgs -> Integer)
-> Integer -> CryptoFileArgs -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
C.authTagSize) Maybe CryptoFileArgs
fromArgs
            CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a.
CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO a)
-> ExceptT FTCryptoError IO a
CF.withFile CryptoFile
fromCF IOMode
ReadMode ((CryptoFileHandle -> ExceptT FTCryptoError IO ())
 -> ExceptT FTCryptoError IO ())
-> (CryptoFileHandle -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ \CryptoFileHandle
fromH ->
              CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a.
CryptoFile
-> IOMode
-> (CryptoFileHandle -> ExceptT FTCryptoError IO a)
-> ExceptT FTCryptoError IO a
CF.withFile CryptoFile
toCF IOMode
WriteMode ((CryptoFileHandle -> ExceptT FTCryptoError IO ())
 -> ExceptT FTCryptoError IO ())
-> (CryptoFileHandle -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ \CryptoFileHandle
toH -> do
                CryptoFileHandle
-> CryptoFileHandle -> Integer -> ExceptT FTCryptoError IO ()
copyChunks CryptoFileHandle
fromH CryptoFileHandle
toH Integer
fromSize
                Maybe CryptoFileArgs
-> (CryptoFileArgs -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CryptoFileArgs
fromArgs ((CryptoFileArgs -> ExceptT FTCryptoError IO ())
 -> ExceptT FTCryptoError IO ())
-> (CryptoFileArgs -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ \CryptoFileArgs
_ -> CryptoFileHandle -> ExceptT FTCryptoError IO ()
CF.hGetTag CryptoFileHandle
fromH
                Maybe CryptoFileArgs
-> (CryptoFileArgs -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CryptoFileArgs
toArgs ((CryptoFileArgs -> ExceptT FTCryptoError IO ())
 -> ExceptT FTCryptoError IO ())
-> (CryptoFileArgs -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ \CryptoFileArgs
_ -> IO () -> ExceptT FTCryptoError IO ()
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FTCryptoError IO ())
-> IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ CryptoFileHandle -> IO ()
CF.hPutTag CryptoFileHandle
toH
            where
              copyChunks :: CF.CryptoFileHandle -> CF.CryptoFileHandle -> Integer -> ExceptT CF.FTCryptoError IO ()
              copyChunks :: CryptoFileHandle
-> CryptoFileHandle -> Integer -> ExceptT FTCryptoError IO ()
copyChunks CryptoFileHandle
r CryptoFileHandle
w Integer
size = do
                let chSize :: Integer
chSize = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
size Integer
forall a. Num a => a
U.chunkSize
                    chSize' :: Int
chSize' = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
chSize
                    size' :: Integer
size' = Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
chSize
                ByteString
ch <- IO ByteString -> ExceptT FTCryptoError IO ByteString
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ExceptT FTCryptoError IO ByteString)
-> IO ByteString -> ExceptT FTCryptoError IO ByteString
forall a b. (a -> b) -> a -> b
$ CryptoFileHandle -> Int -> IO ByteString
CF.hGet CryptoFileHandle
r Int
chSize'
                Bool -> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
ch Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
chSize') (ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ FTCryptoError -> ExceptT FTCryptoError IO ()
forall a. FTCryptoError -> ExceptT FTCryptoError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FTCryptoError -> ExceptT FTCryptoError IO ())
-> FTCryptoError -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ String -> FTCryptoError
CF.FTCEFileIOError String
"encrypting file: unexpected EOF"
                IO () -> ExceptT FTCryptoError IO ()
forall a. IO a -> ExceptT FTCryptoError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FTCryptoError IO ())
-> (LazyByteString -> IO ())
-> LazyByteString
-> ExceptT FTCryptoError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoFileHandle -> LazyByteString -> IO ()
CF.hPut CryptoFileHandle
w (LazyByteString -> ExceptT FTCryptoError IO ())
-> LazyByteString -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> LazyByteString
LB.fromStrict ByteString
ch
                Bool -> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
size' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ())
-> ExceptT FTCryptoError IO () -> ExceptT FTCryptoError IO ()
forall a b. (a -> b) -> a -> b
$ CryptoFileHandle
-> CryptoFileHandle -> Integer -> ExceptT FTCryptoError IO ()
copyChunks CryptoFileHandle
r CryptoFileHandle
w Integer
size'
          mediaFilePrefix :: MsgContent -> Maybe FilePath
          mediaFilePrefix :: MsgContent -> Maybe String
mediaFilePrefix = \case
            MCImage {} -> String -> Maybe String
forall a. a -> Maybe a
Just String
imageFilePrefix
            MCVoice {} -> String -> Maybe String
forall a. a -> Maybe a
Just String
voiceFilePrefix
            MCVideo {} -> String -> Maybe String
forall a. a -> Maybe a
Just String
videoFilePrefix
            MsgContent
_ -> Maybe String
forall a. Maybe a
Nothing
          generateNewFileName :: String -> String -> m String
generateNewFileName String
fileName String
prefix = do
            UTCTime
currentDate <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            let formattedDate :: String
formattedDate = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%d_%H%M%S" UTCTime
currentDate
            let ext :: String
ext = String -> String
takeExtension String
fileName
            String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
formattedDate String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ext
  APIUserRead Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO ()
`setUserChatsRead` User
user) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> User -> CM ChatResponse
ok User
user
  ChatCommand
UserRead -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIUserRead Int64
userId
  APIChatRead chatRef :: ChatRef
chatRef@(ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope_) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> case ChatType
cType of
    ChatType
CTDirect -> do
      User
user <- (Connection -> ExceptT StoreError IO User) -> CM User
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO User) -> CM User)
-> (Connection -> ExceptT StoreError IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> ExceptT StoreError IO User
getUserByContactId Connection
db Int64
chatId
      UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      [(Int64, UTCTime)]
timedItems <- (Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)])
-> (Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        [(Int64, Int)]
timedItems <- Connection -> User -> Int64 -> IO [(Int64, Int)]
getDirectUnreadTimedItems Connection
db User
user Int64
chatId
        Connection -> User -> Int64 -> IO ()
updateDirectChatItemsRead Connection
db User
user Int64
chatId
        Connection
-> User
-> Int64
-> [(Int64, Int)]
-> UTCTime
-> IO [(Int64, UTCTime)]
setDirectChatItemsDeleteAt Connection
db User
user Int64
chatId [(Int64, Int)]
timedItems UTCTime
ts
      [(Int64, UTCTime)]
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64, UTCTime)]
timedItems (((Int64, UTCTime)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(Int64
itemId, UTCTime
deleteAt) -> User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatRef
chatRef, Int64
itemId) UTCTime
deleteAt
      User -> CM ChatResponse
ok User
user
    ChatType
CTGroup -> do
      (User
user, GroupInfo
gInfo) <- (Connection -> ExceptT StoreError IO (User, GroupInfo))
-> CM (User, GroupInfo)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (User, GroupInfo))
 -> CM (User, GroupInfo))
-> (Connection -> ExceptT StoreError IO (User, GroupInfo))
-> CM (User, GroupInfo)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        User
user <- Connection -> Int64 -> ExceptT StoreError IO User
getUserByGroupId Connection
db Int64
chatId
        GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
        (User, GroupInfo) -> ExceptT StoreError IO (User, GroupInfo)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (User
user, GroupInfo
gInfo)
      UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      case Maybe GroupChatScope
scope_ of
        Maybe GroupChatScope
Nothing -> do
          [(Int64, UTCTime)]
timedItems <- (Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)])
-> (Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
            [(Int64, Int)]
timedItems <- Connection
-> User -> Int64 -> Maybe GroupChatScope -> IO [(Int64, Int)]
getGroupUnreadTimedItems Connection
db User
user Int64
chatId Maybe GroupChatScope
forall a. Maybe a
Nothing
            Connection -> User -> GroupInfo -> IO ()
updateGroupChatItemsRead Connection
db User
user GroupInfo
gInfo
            Connection
-> User
-> Int64
-> [(Int64, Int)]
-> UTCTime
-> IO [(Int64, UTCTime)]
setGroupChatItemsDeleteAt Connection
db User
user Int64
chatId [(Int64, Int)]
timedItems UTCTime
ts
          [(Int64, UTCTime)]
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64, UTCTime)]
timedItems (((Int64, UTCTime)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(Int64
itemId, UTCTime
deleteAt) -> User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatRef
chatRef, Int64
itemId) UTCTime
deleteAt
          User -> CM ChatResponse
ok User
user
        Just GroupChatScope
scope -> do
          GroupChatScopeInfo
scopeInfo <- VersionRangeChat
-> User
-> GroupChatScope
-> ExceptT ChatError (ReaderT ChatController IO) GroupChatScopeInfo
getChatScopeInfo VersionRangeChat
vr User
user GroupChatScope
scope
          (GroupInfo
gInfo', GroupMember
m', [(Int64, UTCTime)]
timedItems) <- (Connection -> IO (GroupInfo, GroupMember, [(Int64, UTCTime)]))
-> CM (GroupInfo, GroupMember, [(Int64, UTCTime)])
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (GroupInfo, GroupMember, [(Int64, UTCTime)]))
 -> CM (GroupInfo, GroupMember, [(Int64, UTCTime)]))
-> (Connection -> IO (GroupInfo, GroupMember, [(Int64, UTCTime)]))
-> CM (GroupInfo, GroupMember, [(Int64, UTCTime)])
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
            [(Int64, Int)]
timedItems <- Connection
-> User -> Int64 -> Maybe GroupChatScope -> IO [(Int64, Int)]
getGroupUnreadTimedItems Connection
db User
user Int64
chatId (GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just GroupChatScope
scope)
            (GroupInfo
gInfo', GroupMember
m') <- Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupChatScopeInfo
-> IO (GroupInfo, GroupMember)
updateSupportChatItemsRead Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo GroupChatScopeInfo
scopeInfo
            [(Int64, UTCTime)]
timedItems' <- Connection
-> User
-> Int64
-> [(Int64, Int)]
-> UTCTime
-> IO [(Int64, UTCTime)]
setGroupChatItemsDeleteAt Connection
db User
user Int64
chatId [(Int64, Int)]
timedItems UTCTime
ts
            (GroupInfo, GroupMember, [(Int64, UTCTime)])
-> IO (GroupInfo, GroupMember, [(Int64, UTCTime)])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
gInfo', GroupMember
m', [(Int64, UTCTime)]
timedItems')
          [(Int64, UTCTime)]
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64, UTCTime)]
timedItems (((Int64, UTCTime)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(Int64
itemId, UTCTime
deleteAt) -> User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatRef
chatRef, Int64
itemId) UTCTime
deleteAt
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ChatResponse
CRMemberSupportChatRead User
user GroupInfo
gInfo' GroupMember
m'
    ChatType
CTLocal -> do
      User
user <- (Connection -> ExceptT StoreError IO User) -> CM User
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO User) -> CM User)
-> (Connection -> ExceptT StoreError IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> ExceptT StoreError IO User
getUserByNoteFolderId Connection
db Int64
chatId
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> IO ()
updateLocalChatItemsRead Connection
db User
user Int64
chatId
      User -> CM ChatResponse
ok User
user
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APIChatItemsRead chatRef :: ChatRef
chatRef@(ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) NonEmpty Int64
itemIds -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> case ChatType
cType of
    ChatType
CTDirect -> do
      (User
user, Contact
ct) <- (Connection -> ExceptT StoreError IO (User, Contact))
-> CM (User, Contact)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (User, Contact))
 -> CM (User, Contact))
-> (Connection -> ExceptT StoreError IO (User, Contact))
-> CM (User, Contact)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        User
user <- Connection -> Int64 -> ExceptT StoreError IO User
getUserByContactId Connection
db Int64
chatId
        Contact
ct <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
        (User, Contact) -> ExceptT StoreError IO (User, Contact)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (User
user, Contact
ct)
      [(Int64, UTCTime)]
timedItems <- (Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)])
-> (Connection -> IO [(Int64, UTCTime)]) -> CM [(Int64, UTCTime)]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        [(Int64, Int)]
timedItems <- Connection -> User -> Int64 -> NonEmpty Int64 -> IO [(Int64, Int)]
updateDirectChatItemsReadList Connection
db User
user Int64
chatId NonEmpty Int64
itemIds
        Connection
-> User
-> Int64
-> [(Int64, Int)]
-> UTCTime
-> IO [(Int64, UTCTime)]
setDirectChatItemsDeleteAt Connection
db User
user Int64
chatId [(Int64, Int)]
timedItems (UTCTime -> IO [(Int64, UTCTime)])
-> IO UTCTime -> IO [(Int64, UTCTime)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
      [(Int64, UTCTime)]
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64, UTCTime)]
timedItems (((Int64, UTCTime)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(Int64
itemId, UTCTime
deleteAt) -> User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatRef
chatRef, Int64
itemId) UTCTime
deleteAt
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatResponse
CRItemsReadForChat User
user (SChatType 'CTDirect -> ChatInfo 'CTDirect -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect -> AChatInfo)
-> ChatInfo 'CTDirect -> AChatInfo
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct)
    ChatType
CTGroup -> do
      (User
user, GroupInfo
gInfo) <- (Connection -> ExceptT StoreError IO (User, GroupInfo))
-> CM (User, GroupInfo)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (User, GroupInfo))
 -> CM (User, GroupInfo))
-> (Connection -> ExceptT StoreError IO (User, GroupInfo))
-> CM (User, GroupInfo)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        User
user <- Connection -> Int64 -> ExceptT StoreError IO User
getUserByGroupId Connection
db Int64
chatId
        GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
        (User, GroupInfo) -> ExceptT StoreError IO (User, GroupInfo)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (User
user, GroupInfo
gInfo)
      Maybe GroupChatScopeInfo
chatScopeInfo <- (GroupChatScope
 -> ExceptT
      ChatError (ReaderT ChatController IO) GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (VersionRangeChat
-> User
-> GroupChatScope
-> ExceptT ChatError (ReaderT ChatController IO) GroupChatScopeInfo
getChatScopeInfo VersionRangeChat
vr User
user) Maybe GroupChatScope
scope
      ([(Int64, UTCTime)]
timedItems, GroupInfo
gInfo') <- (Connection
 -> ExceptT StoreError IO ([(Int64, UTCTime)], GroupInfo))
-> CM ([(Int64, UTCTime)], GroupInfo)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO ([(Int64, UTCTime)], GroupInfo))
 -> CM ([(Int64, UTCTime)], GroupInfo))
-> (Connection
    -> ExceptT StoreError IO ([(Int64, UTCTime)], GroupInfo))
-> CM ([(Int64, UTCTime)], GroupInfo)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        ([(Int64, Int)]
timedItems, GroupInfo
gInfo') <- Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> NonEmpty Int64
-> ExceptT StoreError IO ([(Int64, Int)], GroupInfo)
updateGroupChatItemsReadList Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo NonEmpty Int64
itemIds
        [(Int64, UTCTime)]
timedItems' <- IO [(Int64, UTCTime)] -> ExceptT StoreError IO [(Int64, UTCTime)]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Int64, UTCTime)] -> ExceptT StoreError IO [(Int64, UTCTime)])
-> IO [(Int64, UTCTime)]
-> ExceptT StoreError IO [(Int64, UTCTime)]
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Int64
-> [(Int64, Int)]
-> UTCTime
-> IO [(Int64, UTCTime)]
setGroupChatItemsDeleteAt Connection
db User
user Int64
chatId [(Int64, Int)]
timedItems (UTCTime -> IO [(Int64, UTCTime)])
-> IO UTCTime -> IO [(Int64, UTCTime)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
        ([(Int64, UTCTime)], GroupInfo)
-> ExceptT StoreError IO ([(Int64, UTCTime)], GroupInfo)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Int64, UTCTime)]
timedItems', GroupInfo
gInfo')
      [(Int64, UTCTime)]
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64, UTCTime)]
timedItems (((Int64, UTCTime)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((Int64, UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(Int64
itemId, UTCTime
deleteAt) -> User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatRef
chatRef, Int64
itemId) UTCTime
deleteAt
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatResponse
CRItemsReadForChat User
user (SChatType 'CTGroup -> ChatInfo 'CTGroup -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTGroup
SCTGroup (ChatInfo 'CTGroup -> AChatInfo) -> ChatInfo 'CTGroup -> AChatInfo
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo' Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing)
    ChatType
CTLocal -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactRequest -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatType
CTContactConnection -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APIChatUnread (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) Bool
unreadChat -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
cType of
    ChatType
CTDirect -> do
      (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        Contact
ct <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Contact -> Bool -> IO ()
updateContactUnreadChat Connection
db User
user Contact
ct Bool
unreadChat
      User -> CM ChatResponse
ok User
user
    -- TODO [knocking] set support chat as unread?
    ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope -> do
      (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> GroupInfo -> Bool -> IO ()
updateGroupUnreadChat Connection
db User
user GroupInfo
gInfo Bool
unreadChat
      User -> CM ChatResponse
ok User
user
    ChatType
CTLocal -> do
      (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        NoteFolder
nf <- Connection -> User -> Int64 -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user Int64
chatId
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> NoteFolder -> Bool -> IO ()
updateNoteFolderUnreadChat Connection
db User
user NoteFolder
nf Bool
unreadChat
      User -> CM ChatResponse
ok User
user
    ChatType
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APIDeleteChat cRef :: ChatRef
cRef@(ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) ChatDeleteMode
cdm -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> case ChatType
cType of
    ChatType
CTDirect -> do
      Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
      [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> IO [CIFileInfo]
getContactFileInfo Connection
db User
user Contact
ct
      Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"deleteChat direct" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
        case ChatDeleteMode
cdm of
          CDMFull Bool
notify -> do
            User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteCIFiles User
user [CIFileInfo]
filesInfo
            Contact -> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
sendDelDeleteConns Contact
ct Bool
notify
            -- functions below are called in separate transactions to prevent crashes on android
            -- (possibly, race condition on integrity check?)
            (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
              Connection -> User -> Contact -> IO ()
deleteContactConnections Connection
db User
user Contact
ct
              Connection -> User -> Contact -> IO ()
deleteContactFiles Connection
db User
user Contact
ct
            (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContact Connection
db User
user Contact
ct
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRContactDeleted User
user Contact
ct
          CDMEntity Bool
notify -> do
            User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
cancelFilesInProgress User
user [CIFileInfo]
filesInfo
            Contact -> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
sendDelDeleteConns Contact
ct Bool
notify
            Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
              IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Contact -> IO ()
deleteContactConnections Connection
db User
user Contact
ct
              IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ IO Contact -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Contact -> IO ()) -> IO Contact -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Contact -> ContactStatus -> IO Contact
updateContactStatus Connection
db User
user Contact
ct ContactStatus
CSDeletedByUser
              Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRContactDeleted User
user Contact
ct'
          ChatDeleteMode
CDMMessages -> do
            CM ChatResponse -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM ChatResponse
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM ChatResponse
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatCommand
APIClearChat ChatRef
cRef
            (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> Bool -> IO ()
setContactChatDeleted Connection
db User
user Contact
ct Bool
True
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRContactDeleted User
user Contact
ct {chatDeleted = True}
      where
        sendDelDeleteConns :: Contact -> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
sendDelDeleteConns Contact
ct Bool
notify = do
          let doSendDel :: Bool
doSendDel = Contact -> Bool
contactReady Contact
ct Bool -> Bool -> Bool
&& Contact -> Bool
contactActive Contact
ct Bool -> Bool -> Bool
&& Bool
notify
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doSendDel (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ CM (SndMessage, Int64)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct ChatMsgEvent 'Json
XDirectDel) ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ExceptT ChatError (ReaderT ChatController IO) ()
-> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. a -> b -> a
const (() -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
          [ByteString]
contactConnIds <- (Connection -> ByteString) -> [Connection] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Connection -> ByteString
aConnId ([Connection] -> [ByteString])
-> ExceptT ChatError (ReaderT ChatController IO) [Connection]
-> ExceptT ChatError (ReaderT ChatController IO) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [Connection])
-> ExceptT ChatError (ReaderT ChatController IO) [Connection]
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat -> Int64 -> Contact -> IO [Connection]
getContactConnections Connection
db VersionRangeChat
vr Int64
userId Contact
ct)
          [ByteString]
-> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteAgentConnectionsAsync' [ByteString]
contactConnIds Bool
doSendDel
    ChatType
CTContactConnection -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withConnectionLock Text
"deleteChat contactConnection" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      conn :: PendingContactConnection
conn@PendingContactConnection {pccAgentConnId :: PendingContactConnection -> AgentConnId
pccAgentConnId = AgentConnId ByteString
acId} <- (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64 -> Int64 -> ExceptT StoreError IO PendingContactConnection
getPendingContactConnection Connection
db Int64
userId Int64
chatId
      ByteString -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteAgentConnectionAsync ByteString
acId
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Int64 -> IO ()
deletePendingContactConnection Connection
db Int64
userId Int64
chatId
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> PendingContactConnection -> ChatResponse
CRContactConnectionDeleted User
user PendingContactConnection
conn
    ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope -> do
      gInfo :: GroupInfo
gInfo@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
      let GroupMember {memberRole :: GroupMember -> GroupMemberRole
memberRole = GroupMemberRole
membershipMemRole} = GroupMember
membership
      let isOwner :: Bool
isOwner = GroupMemberRole
membershipMemRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberRole
GROwner
          canDelete :: Bool
canDelete = Bool
isOwner Bool -> Bool -> Bool
|| Bool -> Bool
not (GroupMember -> Bool
memberCurrent GroupMember
membership)
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
canDelete (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMemberRole -> ChatErrorType
CEGroupUserRole GroupInfo
gInfo GroupMemberRole
GROwner
      [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO [CIFileInfo]
getGroupFileInfo Connection
db User
user GroupInfo
gInfo
      Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"deleteChat group" Int64
chatId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
        User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteCIFiles User
user [CIFileInfo]
filesInfo
        ([GroupMember]
members, [GroupMember]
recipients) <- GroupInfo
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
getRecipients GroupInfo
gInfo
        let doSendDel :: Bool
doSendDel = GroupMember -> Bool
memberActive GroupMember
membership Bool -> Bool -> Bool
&& Bool
isOwner
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doSendDel (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (CM SndMessage
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM SndMessage
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM SndMessage
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage
sendGroupMessage' User
user GroupInfo
gInfo [GroupMember]
recipients ChatMsgEvent 'Json
XGrpDel
        User
-> GroupInfo -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteGroupLinkIfExists User
user GroupInfo
gInfo
        User
-> [GroupMember]
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
deleteMembersConnections' User
user [GroupMember]
members Bool
doSendDel
        User
-> GroupInfo
-> CIGroupInvitationStatus
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateCIGroupInvitationStatus User
user GroupInfo
gInfo CIGroupInvitationStatus
CIGISRejected ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
_ -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO ()
deleteGroupChatItems Connection
db User
user GroupInfo
gInfo
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO ()
cleanupHostGroupLinkConn Connection
db User
user GroupInfo
gInfo
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO ()
deleteGroupMembers Connection
db User
user GroupInfo
gInfo
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO ()
deleteGroup Connection
db User
user GroupInfo
gInfo
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> ChatResponse
CRGroupDeletedUser User
user GroupInfo
gInfo
        where
          getRecipients :: GroupInfo
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
getRecipients gInfo :: GroupInfo
gInfo@GroupInfo {BoolDef
useRelays :: BoolDef
useRelays :: GroupInfo -> BoolDef
useRelays}
            | BoolDef -> Bool
isTrue BoolDef
useRelays = do
                [GroupMember]
relays <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupRelays Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
                ([GroupMember], [GroupMember])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GroupMember]
relays, [GroupMember]
relays)
            | Bool
otherwise = do
                [GroupMember]
ms <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
                ([GroupMember], [GroupMember])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GroupMember]
ms, (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrentOrPending [GroupMember]
ms)
    ChatType
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APIClearChat (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> case ChatType
cType of
    ChatType
CTDirect -> do
      Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
      [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> IO [CIFileInfo]
getContactFileInfo Connection
db User
user Contact
ct
      User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteCIFiles User
user [CIFileInfo]
filesInfo
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> IO ()
deleteContactCIs Connection
db User
user Contact
ct
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatResponse
CRChatCleared User
user (SChatType 'CTDirect -> ChatInfo 'CTDirect -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect -> AChatInfo)
-> ChatInfo 'CTDirect -> AChatInfo
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct)
    ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope -> do
      GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
      [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO [CIFileInfo]
getGroupFileInfo Connection
db User
user GroupInfo
gInfo
      User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteCIFiles User
user [CIFileInfo]
filesInfo
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO ()
deleteGroupChatItemsMessages Connection
db User
user GroupInfo
gInfo
      [GroupMember]
membersToDelete <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
      [GroupMember]
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMember]
membersToDelete ((GroupMember -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \GroupMember
m -> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupMember -> IO ()
deleteGroupMember Connection
db User
user GroupMember
m
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatResponse
CRChatCleared User
user (SChatType 'CTGroup -> ChatInfo 'CTGroup -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTGroup
SCTGroup (ChatInfo 'CTGroup -> AChatInfo) -> ChatInfo 'CTGroup -> AChatInfo
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing)
    ChatType
CTLocal -> do
      NoteFolder
nf <- (Connection -> ExceptT StoreError IO NoteFolder) -> CM NoteFolder
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO NoteFolder) -> CM NoteFolder)
-> (Connection -> ExceptT StoreError IO NoteFolder)
-> CM NoteFolder
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user Int64
chatId
      [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> NoteFolder -> IO [CIFileInfo]
getNoteFolderFileInfo Connection
db User
user NoteFolder
nf
      [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteFilesLocally [CIFileInfo]
filesInfo
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> NoteFolder -> IO ()
deleteNoteFolderFiles Connection
db Int64
userId NoteFolder
nf
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> NoteFolder -> IO ()
deleteNoteFolderCIs Connection
db User
user NoteFolder
nf
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatResponse
CRChatCleared User
user (SChatType 'CTLocal -> ChatInfo 'CTLocal -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTLocal
SCTLocal (ChatInfo 'CTLocal -> AChatInfo) -> ChatInfo 'CTLocal -> AChatInfo
forall a b. (a -> b) -> a -> b
$ NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf)
    ChatType
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APIAcceptContact Bool
incognito Int64
connReqId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))
uclData_ <- (Connection
 -> ExceptT
      StoreError
      IO
      (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))))
-> CM (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo)))
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError
       IO
       (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))))
 -> CM (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))))
-> (Connection
    -> ExceptT
         StoreError
         IO
         (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))))
-> CM (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo)))
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Maybe Int64
uclId_ <- Connection -> Int64 -> ExceptT StoreError IO (Maybe Int64)
getUserContactLinkIdByCReq Connection
db Int64
connReqId
      Maybe Int64
-> (Int64
    -> ExceptT
         StoreError IO (Int64, (UserContactLink, Maybe GroupLinkInfo)))
-> ExceptT
     StoreError
     IO
     (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int64
uclId_ ((Int64
  -> ExceptT
       StoreError IO (Int64, (UserContactLink, Maybe GroupLinkInfo)))
 -> ExceptT
      StoreError
      IO
      (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))))
-> (Int64
    -> ExceptT
         StoreError IO (Int64, (UserContactLink, Maybe GroupLinkInfo)))
-> ExceptT
     StoreError
     IO
     (Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo)))
forall a b. (a -> b) -> a -> b
$ \Int64
uclId -> do -- address may be deleted
        (UserContactLink, Maybe GroupLinkInfo)
uclGLinkInfo <- Connection
-> Int64
-> Int64
-> ExceptT StoreError IO (UserContactLink, Maybe GroupLinkInfo)
getUserContactLinkById Connection
db Int64
userId Int64
uclId
        (Int64, (UserContactLink, Maybe GroupLinkInfo))
-> ExceptT
     StoreError IO (Int64, (UserContactLink, Maybe GroupLinkInfo))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
uclId, (UserContactLink, Maybe GroupLinkInfo)
uclGLinkInfo)
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactRequestLock Text
"acceptContact" Int64
connReqId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ case Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))
uclData_ of
      Maybe (Int64, (UserContactLink, Maybe GroupLinkInfo))
Nothing -> do -- address was deleted
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
incognito (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"incognito not allowed when address is not found"
        UserContactRequest
cReq <- (Connection -> ExceptT StoreError IO UserContactRequest)
-> CM UserContactRequest
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO UserContactRequest)
 -> CM UserContactRequest)
-> (Connection -> ExceptT StoreError IO UserContactRequest)
-> CM UserContactRequest
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User -> Int64 -> ExceptT StoreError IO UserContactRequest
getContactRequest Connection
db User
user Int64
connReqId
        (Contact
ct, Bool
_sqSecured) <- User
-> UserContactRequest
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) (Contact, Bool)
acceptCReq User
user UserContactRequest
cReq Bool
True
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRAcceptingContactRequest User
user Contact
ct
      Just (Int64
uclId, (ucl :: UserContactLink
ucl@UserContactLink {Bool
shortLinkDataSet :: Bool
shortLinkDataSet :: UserContactLink -> Bool
shortLinkDataSet}, Maybe GroupLinkInfo
gLinkInfo_)) -> do
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
shortLinkDataSet Bool -> Bool -> Bool
&& Bool
incognito) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"incognito not allowed for address with short link data"
        Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withUserContactLock Text
"acceptContact" Int64
uclId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
          UserContactRequest
cReq <- (Connection -> ExceptT StoreError IO UserContactRequest)
-> CM UserContactRequest
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO UserContactRequest)
 -> CM UserContactRequest)
-> (Connection -> ExceptT StoreError IO UserContactRequest)
-> CM UserContactRequest
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User -> Int64 -> ExceptT StoreError IO UserContactRequest
getContactRequest Connection
db User
user Int64
connReqId
          let contactUsed :: Bool
contactUsed = Maybe GroupLinkInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupLinkInfo
gLinkInfo_ -- for redundancy, as group link requests are auto-accepted
          (Contact
ct, Bool
sqSecured) <- User
-> UserContactRequest
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) (Contact, Bool)
acceptCReq User
user UserContactRequest
cReq Bool
contactUsed
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sqSecured (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> Contact
-> UserContactLink
-> UserContactRequest
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendWelcomeMsg User
user Contact
ct UserContactLink
ucl UserContactRequest
cReq
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRAcceptingContactRequest User
user Contact
ct
    where
      acceptCReq :: User
-> UserContactRequest
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) (Contact, Bool)
acceptCReq User
user UserContactRequest
cReq Bool
contactUsed = do
        (Contact
ct, Connection
conn, Bool
sqSecured) <- NetworkRequestMode
-> User
-> UserContactRequest
-> Bool
-> CM (Contact, Connection, Bool)
acceptContactRequest NetworkRequestMode
nm User
user UserContactRequest
cReq Bool
incognito
        Contact
ct' <- (Connection -> IO Contact) -> CM Contact
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO Contact) -> CM Contact)
-> (Connection -> IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          Connection -> User -> Contact -> Bool -> IO ()
updateContactAccepted Connection
db User
user Contact
ct Bool
contactUsed
          Connection
conn' <-
            if Bool
sqSecured
              then Connection
-> Connection -> ConnStatus -> ConnStatus -> IO Connection
updateConnectionStatusFromTo Connection
db Connection
conn ConnStatus
ConnNew ConnStatus
ConnSndReady
              else Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
conn
          Contact -> IO Contact
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
ct {contactUsed, activeConn = Just conn'}
        (Contact, Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (Contact, Bool)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contact
ct', Bool
sqSecured)
      sendWelcomeMsg :: User
-> Contact
-> UserContactLink
-> UserContactRequest
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendWelcomeMsg User
user Contact
ct UserContactLink
ucl UserContactRequest {Maybe SharedMsgId
welcomeSharedMsgId :: Maybe SharedMsgId
welcomeSharedMsgId :: UserContactRequest -> Maybe SharedMsgId
welcomeSharedMsgId} =
        Maybe MsgContent
-> (MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (AddressSettings -> Maybe MsgContent
autoReply (AddressSettings -> Maybe MsgContent)
-> AddressSettings -> Maybe MsgContent
forall a b. (a -> b) -> a -> b
$ UserContactLink -> AddressSettings
addressSettings UserContactLink
ucl) ((MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \MsgContent
mc -> case Maybe SharedMsgId
welcomeSharedMsgId of
          Just SharedMsgId
smId ->
            CM (SndMessage, Int64)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM (SndMessage, Int64)
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM (SndMessage, Int64)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall a b. (a -> b) -> a -> b
$ SharedMsgId
-> MsgContent
-> Map Text MsgMention
-> Maybe Int
-> Maybe Bool
-> Maybe MsgScope
-> ChatMsgEvent 'Json
XMsgUpdate SharedMsgId
smId MsgContent
mc Map Text MsgMention
forall k a. Map k a
M.empty Maybe Int
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe MsgScope
forall a. Maybe a
Nothing
          Maybe SharedMsgId
Nothing -> do
            (SndMessage
msg, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall a b. (a -> b) -> a -> b
$ MsgContainer -> ChatMsgEvent 'Json
XMsgNew (MsgContainer -> ChatMsgEvent 'Json)
-> MsgContainer -> ChatMsgEvent 'Json
forall a b. (a -> b) -> a -> b
$ ExtMsgContent -> MsgContainer
MCSimple (ExtMsgContent -> MsgContainer) -> ExtMsgContent -> MsgContainer
forall a b. (a -> b) -> a -> b
$ MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent MsgContent
mc Maybe FileInvitation
forall a. Maybe a
Nothing
            ChatItem 'CTDirect 'MDSnd
ci <- User
-> ChatDirection 'CTDirect 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem 'CTDirect 'MDSnd)
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem c 'MDSnd)
saveSndChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) SndMessage
msg (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc)
            ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ChatItem 'CTDirect 'MDSnd
ci]
  APIRejectContact Int64
connReqId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Maybe Int64
uclId_ <- (Connection -> ExceptT StoreError IO (Maybe Int64))
-> CM (Maybe Int64)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Maybe Int64))
 -> CM (Maybe Int64))
-> (Connection -> ExceptT StoreError IO (Maybe Int64))
-> CM (Maybe Int64)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> ExceptT StoreError IO (Maybe Int64)
getUserContactLinkIdByCReq Connection
db Int64
connReqId
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactRequestLock Text
"rejectContact" Int64
connReqId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ case Maybe Int64
uclId_ of
      Maybe Int64
Nothing -> User -> CM ChatResponse
rejectCReq User
user -- address was deleted
      Just Int64
uclId -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withUserContactLock Text
"rejectContact" Int64
uclId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> CM ChatResponse
rejectCReq User
user
    where
      rejectCReq :: User -> CM ChatResponse
rejectCReq User
user = do
        (cReq :: UserContactRequest
cReq@UserContactRequest {agentInvitationId :: UserContactRequest -> AgentInvId
agentInvitationId = AgentInvId ByteString
invId}, Maybe Contact
ct_) <-
          (Connection
 -> ExceptT StoreError IO (UserContactRequest, Maybe Contact))
-> CM (UserContactRequest, Maybe Contact)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (UserContactRequest, Maybe Contact))
 -> CM (UserContactRequest, Maybe Contact))
-> (Connection
    -> ExceptT StoreError IO (UserContactRequest, Maybe Contact))
-> CM (UserContactRequest, Maybe Contact)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
            cReq :: UserContactRequest
cReq@UserContactRequest {Maybe Int64
contactId_ :: Maybe Int64
contactId_ :: UserContactRequest -> Maybe Int64
contactId_} <- Connection
-> User -> Int64 -> ExceptT StoreError IO UserContactRequest
getContactRequest Connection
db User
user Int64
connReqId
            Maybe Contact
ct_ <- Maybe Int64
-> (Int64 -> ExceptT StoreError IO Contact)
-> ExceptT StoreError IO (Maybe Contact)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int64
contactId_ ((Int64 -> ExceptT StoreError IO Contact)
 -> ExceptT StoreError IO (Maybe Contact))
-> (Int64 -> ExceptT StoreError IO Contact)
-> ExceptT StoreError IO (Maybe Contact)
forall a b. (a -> b) -> a -> b
$ \Int64
contactId -> do
              Contact
ct <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
              Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContact Connection
db User
user Contact
ct
              Contact -> ExceptT StoreError IO Contact
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
ct
            IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Int64 -> IO ()
deleteContactRequest Connection
db User
user Int64
connReqId
            (UserContactRequest, Maybe Contact)
-> ExceptT StoreError IO (UserContactRequest, Maybe Contact)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserContactRequest
cReq, Maybe Contact
ct_)
        (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (AgentClient -> ByteString -> ExceptT AgentErrorType IO ()
`rejectContact` ByteString
invId)
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> UserContactRequest -> Maybe Contact -> ChatResponse
CRContactRequestRejected User
user UserContactRequest
cReq Maybe Contact
ct_
  APISendCallInvitation Int64
contactId CallType
callType -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    -- party initiating call
    Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    User
-> MsgDirection
-> Contact
-> CMEventTag 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (e :: MsgEncoding).
User
-> MsgDirection
-> Contact
-> CMEventTag e
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDirectAllowed User
user MsgDirection
MDSnd Contact
ct CMEventTag 'Json
XCallInv_
    if SChatFeature 'CFCalls -> (PrefEnabled -> Bool) -> Contact -> Bool
forall (f :: ChatFeature).
SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool
featureAllowed SChatFeature 'CFCalls
SCFCalls PrefEnabled -> Bool
forUser Contact
ct
      then do
        TMap Int64 Call
calls <- (ChatController -> TMap Int64 Call)
-> ExceptT ChatError (ReaderT ChatController IO) (TMap Int64 Call)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Call
currentCalls
        Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"sendCallInvitation" Int64
contactId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
          TVar ChaChaDRG
g <- (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random
          CallId
callId <- STM CallId -> ExceptT ChatError (ReaderT ChatController IO) CallId
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM CallId
 -> ExceptT ChatError (ReaderT ChatController IO) CallId)
-> STM CallId
-> ExceptT ChatError (ReaderT ChatController IO) CallId
forall a b. (a -> b) -> a -> b
$ ByteString -> CallId
CallId (ByteString -> CallId) -> STM ByteString -> STM CallId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> TVar ChaChaDRG -> STM ByteString
C.randomBytes Int
16 TVar ChaChaDRG
g
          Text
callUUID <- UUID -> Text
UUID.toText (UUID -> Text)
-> ExceptT ChatError (ReaderT ChatController IO) UUID
-> ExceptT ChatError (ReaderT ChatController IO) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID -> ExceptT ChatError (ReaderT ChatController IO) UUID
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
V4.nextRandom
          Maybe (PublicKeyX25519, PrivateKeyX25519)
dhKeyPair <- STM (Maybe (PublicKeyX25519, PrivateKeyX25519))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (PublicKeyX25519, PrivateKeyX25519))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe (PublicKeyX25519, PrivateKeyX25519))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe (PublicKeyX25519, PrivateKeyX25519)))
-> STM (Maybe (PublicKeyX25519, PrivateKeyX25519))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (PublicKeyX25519, PrivateKeyX25519))
forall a b. (a -> b) -> a -> b
$ if CallType -> Bool
encryptedCall CallType
callType then (PublicKeyX25519, PrivateKeyX25519)
-> Maybe (PublicKeyX25519, PrivateKeyX25519)
forall a. a -> Maybe a
Just ((PublicKeyX25519, PrivateKeyX25519)
 -> Maybe (PublicKeyX25519, PrivateKeyX25519))
-> STM (PublicKeyX25519, PrivateKeyX25519)
-> STM (Maybe (PublicKeyX25519, PrivateKeyX25519))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ChaChaDRG -> STM (KeyPair 'X25519)
forall (a :: Algorithm).
AlgorithmI a =>
TVar ChaChaDRG -> STM (KeyPair a)
C.generateKeyPair TVar ChaChaDRG
g else Maybe (PublicKeyX25519, PrivateKeyX25519)
-> STM (Maybe (PublicKeyX25519, PrivateKeyX25519))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PublicKeyX25519, PrivateKeyX25519)
forall a. Maybe a
Nothing
          let invitation :: CallInvitation
invitation = CallInvitation {CallType
callType :: CallType
callType :: CallType
callType, callDhPubKey :: Maybe PublicKeyX25519
callDhPubKey = (PublicKeyX25519, PrivateKeyX25519) -> PublicKeyX25519
forall a b. (a, b) -> a
fst ((PublicKeyX25519, PrivateKeyX25519) -> PublicKeyX25519)
-> Maybe (PublicKeyX25519, PrivateKeyX25519)
-> Maybe PublicKeyX25519
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PublicKeyX25519, PrivateKeyX25519)
dhKeyPair}
              callState :: CallState
callState = CallInvitationSent {localCallType :: CallType
localCallType = CallType
callType, localDhPrivKey :: Maybe PrivateKeyX25519
localDhPrivKey = (PublicKeyX25519, PrivateKeyX25519) -> PrivateKeyX25519
forall a b. (a, b) -> b
snd ((PublicKeyX25519, PrivateKeyX25519) -> PrivateKeyX25519)
-> Maybe (PublicKeyX25519, PrivateKeyX25519)
-> Maybe PrivateKeyX25519
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PublicKeyX25519, PrivateKeyX25519)
dhKeyPair}
          (SndMessage
msg, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (CallId -> CallInvitation -> ChatMsgEvent 'Json
XCallInv CallId
callId CallInvitation
invitation)
          ChatItem 'CTDirect 'MDSnd
ci <- User
-> ChatDirection 'CTDirect 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem 'CTDirect 'MDSnd)
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem c 'MDSnd)
saveSndChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) SndMessage
msg (CICallStatus -> Int -> CIContent 'MDSnd
CISndCall CICallStatus
CISCallPending Int
0)
          let call' :: Call
call' = Call {Int64
contactId :: Int64
contactId :: Int64
contactId, CallId
callId :: CallId
callId :: CallId
callId, Text
callUUID :: Text
callUUID :: Text
callUUID, chatItemId :: Int64
chatItemId = ChatItem 'CTDirect 'MDSnd -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem 'CTDirect 'MDSnd
ci, CallState
callState :: CallState
callState :: CallState
callState, callTs :: UTCTime
callTs = ChatItem 'CTDirect 'MDSnd -> UTCTime
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> UTCTime
chatItemTs' ChatItem 'CTDirect 'MDSnd
ci}
          Maybe Call
call_ <- STM (Maybe Call)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe Call)
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> STM (Maybe Call)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ Int64 -> Call -> TMap Int64 Call -> STM (Maybe Call)
forall k a. Ord k => k -> a -> TMap k a -> STM (Maybe a)
TM.lookupInsert Int64
contactId Call
call' TMap Int64 Call
calls
          Maybe Call
-> (Call -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Call
call_ ((Call -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Call -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Call
call -> User
-> Contact
-> Call
-> WebRTCCallStatus
-> Maybe Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateCallItemStatus User
user Contact
ct Call
call WebRTCCallStatus
WCSDisconnected Maybe Int64
forall a. Maybe a
Nothing
          ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ChatItem 'CTDirect 'MDSnd
ci]
          User -> CM ChatResponse
ok User
user
      else String -> CM ChatResponse
forall a. String -> CM a
throwCmdError (String -> CM ChatResponse) -> String -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ String
"feature not allowed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ChatFeature -> Text
chatFeatureNameText ChatFeature
CFCalls)
  SendCallInvitation Text
cName CallType
callType -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
contactId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
cName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> CallType -> ChatCommand
APISendCallInvitation Int64
contactId CallType
callType
  APIRejectCall Int64
contactId ->
    -- party accepting call
    Int64
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
withCurrentCall Int64
contactId ((User
  -> Contact
  -> Call
  -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
 -> CM ChatResponse)
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user Contact
ct Call {Int64
chatItemId :: Call -> Int64
chatItemId :: Int64
chatItemId, CallState
callState :: Call -> CallState
callState :: CallState
callState} -> case CallState
callState of
      CallInvitationReceived {} -> do
        let aciContent :: ACIContent
aciContent = SMsgDirection 'MDRcv -> CIContent 'MDRcv -> ACIContent
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIContent d -> ACIContent
ACIContent SMsgDirection 'MDRcv
SMDRcv (CIContent 'MDRcv -> ACIContent) -> CIContent 'MDRcv -> ACIContent
forall a b. (a -> b) -> a -> b
$ CICallStatus -> Int -> CIContent 'MDRcv
CIRcvCall CICallStatus
CISCallRejected Int
0
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Int64 -> IO ()
setDirectChatItemRead Connection
db User
user Int64
contactId Int64
chatItemId
        Maybe CITimed
timed_ <- Contact -> CM (Maybe CITimed)
contactCITimed Contact
ct
        User
-> Contact
-> Int64
-> ACIContent
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateDirectChatItemView User
user Contact
ct Int64
chatItemId ACIContent
aciContent Bool
False Bool
False Maybe CITimed
timed_ Maybe Int64
forall a. Maybe a
Nothing
        Maybe UTCTime
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe CITimed
timed_ Maybe CITimed -> (CITimed -> Maybe UTCTime) -> Maybe UTCTime
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CITimed -> Maybe UTCTime
timedDeleteAt') ((UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
          User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing, Int64
chatItemId)
        Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Call
forall a. Maybe a
Nothing
      CallState
_ -> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> (CallStateTag -> ChatErrorType)
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStateTag -> ChatErrorType
CECallState (CallStateTag
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ CallState -> CallStateTag
callStateTag CallState
callState
  APISendCallOffer Int64
contactId WebRTCCallOffer {CallType
callType :: CallType
callType :: WebRTCCallOffer -> CallType
callType, WebRTCSession
rtcSession :: WebRTCSession
rtcSession :: WebRTCCallOffer -> WebRTCSession
rtcSession} ->
    -- party accepting call
    Int64
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
withCurrentCall Int64
contactId ((User
  -> Contact
  -> Call
  -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
 -> CM ChatResponse)
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user Contact
ct call :: Call
call@Call {CallId
callId :: Call -> CallId
callId :: CallId
callId, Int64
chatItemId :: Call -> Int64
chatItemId :: Int64
chatItemId, CallState
callState :: Call -> CallState
callState :: CallState
callState} -> case CallState
callState of
      CallInvitationReceived {CallType
peerCallType :: CallType
peerCallType :: CallState -> CallType
peerCallType, Maybe PublicKeyX25519
localDhPubKey :: Maybe PublicKeyX25519
localDhPubKey :: CallState -> Maybe PublicKeyX25519
localDhPubKey, Maybe Key
sharedKey :: Maybe Key
sharedKey :: CallState -> Maybe Key
sharedKey} -> do
        let callDhPubKey :: Maybe PublicKeyX25519
callDhPubKey = if CallType -> Bool
encryptedCall CallType
callType then Maybe PublicKeyX25519
localDhPubKey else Maybe PublicKeyX25519
forall a. Maybe a
Nothing
            offer :: CallOffer
offer = CallOffer {CallType
callType :: CallType
callType :: CallType
callType, WebRTCSession
rtcSession :: WebRTCSession
rtcSession :: WebRTCSession
rtcSession, Maybe PublicKeyX25519
callDhPubKey :: Maybe PublicKeyX25519
callDhPubKey :: Maybe PublicKeyX25519
callDhPubKey}
            callState' :: CallState
callState' = CallOfferSent {localCallType :: CallType
localCallType = CallType
callType, CallType
peerCallType :: CallType
peerCallType :: CallType
peerCallType, localCallSession :: WebRTCSession
localCallSession = WebRTCSession
rtcSession, Maybe Key
sharedKey :: Maybe Key
sharedKey :: Maybe Key
sharedKey}
            aciContent :: ACIContent
aciContent = SMsgDirection 'MDRcv -> CIContent 'MDRcv -> ACIContent
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIContent d -> ACIContent
ACIContent SMsgDirection 'MDRcv
SMDRcv (CIContent 'MDRcv -> ACIContent) -> CIContent 'MDRcv -> ACIContent
forall a b. (a -> b) -> a -> b
$ CICallStatus -> Int -> CIContent 'MDRcv
CIRcvCall CICallStatus
CISCallAccepted Int
0
        (SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId}, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (CallId -> CallOffer -> ChatMsgEvent 'Json
XCallOffer CallId
callId CallOffer
offer)
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Int64 -> IO ()
setDirectChatItemRead Connection
db User
user Int64
contactId Int64
chatItemId
        User
-> Contact
-> Int64
-> ACIContent
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateDirectChatItemView User
user Contact
ct Int64
chatItemId ACIContent
aciContent Bool
False Bool
False Maybe CITimed
forall a. Maybe a
Nothing (Maybe Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
msgId
        Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Call
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ Call -> Maybe Call
forall a. a -> Maybe a
Just Call
call {callState = callState'}
      CallState
_ -> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> (CallStateTag -> ChatErrorType)
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStateTag -> ChatErrorType
CECallState (CallStateTag
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ CallState -> CallStateTag
callStateTag CallState
callState
  APISendCallAnswer Int64
contactId WebRTCSession
rtcSession ->
    -- party initiating call
    Int64
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
withCurrentCall Int64
contactId ((User
  -> Contact
  -> Call
  -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
 -> CM ChatResponse)
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user Contact
ct call :: Call
call@Call {CallId
callId :: Call -> CallId
callId :: CallId
callId, Int64
chatItemId :: Call -> Int64
chatItemId :: Int64
chatItemId, CallState
callState :: Call -> CallState
callState :: CallState
callState} -> case CallState
callState of
      CallOfferReceived {CallType
localCallType :: CallState -> CallType
localCallType :: CallType
localCallType, CallType
peerCallType :: CallState -> CallType
peerCallType :: CallType
peerCallType, WebRTCSession
peerCallSession :: WebRTCSession
peerCallSession :: CallState -> WebRTCSession
peerCallSession, Maybe Key
sharedKey :: CallState -> Maybe Key
sharedKey :: Maybe Key
sharedKey} -> do
        let callState' :: CallState
callState' = CallNegotiated {CallType
localCallType :: CallType
localCallType :: CallType
localCallType, CallType
peerCallType :: CallType
peerCallType :: CallType
peerCallType, localCallSession :: WebRTCSession
localCallSession = WebRTCSession
rtcSession, WebRTCSession
peerCallSession :: WebRTCSession
peerCallSession :: WebRTCSession
peerCallSession, Maybe Key
sharedKey :: Maybe Key
sharedKey :: Maybe Key
sharedKey}
            aciContent :: ACIContent
aciContent = SMsgDirection 'MDSnd -> CIContent 'MDSnd -> ACIContent
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIContent d -> ACIContent
ACIContent SMsgDirection 'MDSnd
SMDSnd (CIContent 'MDSnd -> ACIContent) -> CIContent 'MDSnd -> ACIContent
forall a b. (a -> b) -> a -> b
$ CICallStatus -> Int -> CIContent 'MDSnd
CISndCall CICallStatus
CISCallNegotiated Int
0
        (SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId}, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (CallId -> CallAnswer -> ChatMsgEvent 'Json
XCallAnswer CallId
callId CallAnswer {WebRTCSession
rtcSession :: WebRTCSession
rtcSession :: WebRTCSession
rtcSession})
        User
-> Contact
-> Int64
-> ACIContent
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateDirectChatItemView User
user Contact
ct Int64
chatItemId ACIContent
aciContent Bool
False Bool
False Maybe CITimed
forall a. Maybe a
Nothing (Maybe Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
msgId
        Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Call
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ Call -> Maybe Call
forall a. a -> Maybe a
Just Call
call {callState = callState'}
      CallState
_ -> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> (CallStateTag -> ChatErrorType)
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStateTag -> ChatErrorType
CECallState (CallStateTag
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ CallState -> CallStateTag
callStateTag CallState
callState
  APISendCallExtraInfo Int64
contactId WebRTCExtraInfo
rtcExtraInfo ->
    -- any call party
    Int64
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
withCurrentCall Int64
contactId ((User
  -> Contact
  -> Call
  -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
 -> CM ChatResponse)
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user Contact
ct call :: Call
call@Call {CallId
callId :: Call -> CallId
callId :: CallId
callId, CallState
callState :: Call -> CallState
callState :: CallState
callState} -> case CallState
callState of
      CallOfferSent {CallType
localCallType :: CallState -> CallType
localCallType :: CallType
localCallType, CallType
peerCallType :: CallState -> CallType
peerCallType :: CallType
peerCallType, WebRTCSession
localCallSession :: CallState -> WebRTCSession
localCallSession :: WebRTCSession
localCallSession, Maybe Key
sharedKey :: CallState -> Maybe Key
sharedKey :: Maybe Key
sharedKey} -> do
        -- TODO update the list of ice servers in localCallSession
        CM (SndMessage, Int64)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM (SndMessage, Int64)
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (ChatMsgEvent 'Json
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ CallId -> CallExtraInfo -> ChatMsgEvent 'Json
XCallExtra CallId
callId CallExtraInfo {WebRTCExtraInfo
rtcExtraInfo :: WebRTCExtraInfo
rtcExtraInfo :: WebRTCExtraInfo
rtcExtraInfo}
        let callState' :: CallState
callState' = CallOfferSent {CallType
localCallType :: CallType
localCallType :: CallType
localCallType, CallType
peerCallType :: CallType
peerCallType :: CallType
peerCallType, WebRTCSession
localCallSession :: WebRTCSession
localCallSession :: WebRTCSession
localCallSession, Maybe Key
sharedKey :: Maybe Key
sharedKey :: Maybe Key
sharedKey}
        Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Call
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ Call -> Maybe Call
forall a. a -> Maybe a
Just Call
call {callState = callState'}
      CallNegotiated {CallType
localCallType :: CallState -> CallType
localCallType :: CallType
localCallType, CallType
peerCallType :: CallState -> CallType
peerCallType :: CallType
peerCallType, WebRTCSession
localCallSession :: CallState -> WebRTCSession
localCallSession :: WebRTCSession
localCallSession, WebRTCSession
peerCallSession :: CallState -> WebRTCSession
peerCallSession :: WebRTCSession
peerCallSession, Maybe Key
sharedKey :: CallState -> Maybe Key
sharedKey :: Maybe Key
sharedKey} -> do
        -- TODO update the list of ice servers in localCallSession
        CM (SndMessage, Int64)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM (SndMessage, Int64)
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (ChatMsgEvent 'Json
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ CallId -> CallExtraInfo -> ChatMsgEvent 'Json
XCallExtra CallId
callId CallExtraInfo {WebRTCExtraInfo
rtcExtraInfo :: WebRTCExtraInfo
rtcExtraInfo :: WebRTCExtraInfo
rtcExtraInfo}
        let callState' :: CallState
callState' = CallNegotiated {CallType
localCallType :: CallType
localCallType :: CallType
localCallType, CallType
peerCallType :: CallType
peerCallType :: CallType
peerCallType, WebRTCSession
localCallSession :: WebRTCSession
localCallSession :: WebRTCSession
localCallSession, WebRTCSession
peerCallSession :: WebRTCSession
peerCallSession :: WebRTCSession
peerCallSession, Maybe Key
sharedKey :: Maybe Key
sharedKey :: Maybe Key
sharedKey}
        Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Call
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ Call -> Maybe Call
forall a. a -> Maybe a
Just Call
call {callState = callState'}
      CallState
_ -> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> (CallStateTag -> ChatErrorType)
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStateTag -> ChatErrorType
CECallState (CallStateTag
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CallStateTag
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a b. (a -> b) -> a -> b
$ CallState -> CallStateTag
callStateTag CallState
callState
  APIEndCall Int64
contactId ->
    -- any call party
    Int64
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
withCurrentCall Int64
contactId ((User
  -> Contact
  -> Call
  -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
 -> CM ChatResponse)
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user Contact
ct call :: Call
call@Call {CallId
callId :: Call -> CallId
callId :: CallId
callId} -> do
      (SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId}, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (CallId -> ChatMsgEvent 'Json
XCallEnd CallId
callId)
      User
-> Contact
-> Call
-> WebRTCCallStatus
-> Maybe Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateCallItemStatus User
user Contact
ct Call
call WebRTCCallStatus
WCSDisconnected (Maybe Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
msgId
      Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Call
forall a. Maybe a
Nothing
  ChatCommand
APIGetCallInvitations -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    Map Int64 Call
calls <- (ChatController -> TMap Int64 Call)
-> ReaderT ChatController IO (TMap Int64 Call)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Call
currentCalls ReaderT ChatController IO (TMap Int64 Call)
-> (TMap Int64 Call -> ReaderT ChatController IO (Map Int64 Call))
-> ReaderT ChatController IO (Map Int64 Call)
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TMap Int64 Call -> ReaderT ChatController IO (Map Int64 Call)
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO
    let invs :: [(Int64, Text, UTCTime, CallType, Maybe Key)]
invs = (Call -> Maybe (Int64, Text, UTCTime, CallType, Maybe Key))
-> [Call] -> [(Int64, Text, UTCTime, CallType, Maybe Key)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Call -> Maybe (Int64, Text, UTCTime, CallType, Maybe Key)
callInvitation ([Call] -> [(Int64, Text, UTCTime, CallType, Maybe Key)])
-> [Call] -> [(Int64, Text, UTCTime, CallType, Maybe Key)]
forall a b. (a -> b) -> a -> b
$ Map Int64 Call -> [Call]
forall k a. Map k a -> [a]
M.elems Map Int64 Call
calls
    [RcvCallInvitation]
rcvCallInvitations <- [Either ChatError RcvCallInvitation] -> [RcvCallInvitation]
forall a b. [Either a b] -> [b]
rights ([Either ChatError RcvCallInvitation] -> [RcvCallInvitation])
-> ReaderT ChatController IO [Either ChatError RcvCallInvitation]
-> ReaderT ChatController IO [RcvCallInvitation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int64, Text, UTCTime, CallType, Maybe Key)
 -> ReaderT ChatController IO (Either ChatError RcvCallInvitation))
-> [(Int64, Text, UTCTime, CallType, Maybe Key)]
-> ReaderT ChatController IO [Either ChatError RcvCallInvitation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int64, Text, UTCTime, CallType, Maybe Key)
-> ReaderT ChatController IO (Either ChatError RcvCallInvitation)
rcvCallInvitation [(Int64, Text, UTCTime, CallType, Maybe Key)]
invs
    ChatResponse -> ReaderT ChatController IO ChatResponse
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> ReaderT ChatController IO ChatResponse)
-> ChatResponse -> ReaderT ChatController IO ChatResponse
forall a b. (a -> b) -> a -> b
$ [RcvCallInvitation] -> ChatResponse
CRCallInvitations [RcvCallInvitation]
rcvCallInvitations
    where
      callInvitation :: Call -> Maybe (Int64, Text, UTCTime, CallType, Maybe Key)
callInvitation Call {Int64
contactId :: Call -> Int64
contactId :: Int64
contactId, Text
callUUID :: Call -> Text
callUUID :: Text
callUUID, CallState
callState :: Call -> CallState
callState :: CallState
callState, UTCTime
callTs :: Call -> UTCTime
callTs :: UTCTime
callTs} = case CallState
callState of
        CallInvitationReceived {CallType
peerCallType :: CallState -> CallType
peerCallType :: CallType
peerCallType, Maybe Key
sharedKey :: CallState -> Maybe Key
sharedKey :: Maybe Key
sharedKey} -> (Int64, Text, UTCTime, CallType, Maybe Key)
-> Maybe (Int64, Text, UTCTime, CallType, Maybe Key)
forall a. a -> Maybe a
Just (Int64
contactId, Text
callUUID, UTCTime
callTs, CallType
peerCallType, Maybe Key
sharedKey)
        CallState
_ -> Maybe (Int64, Text, UTCTime, CallType, Maybe Key)
forall a. Maybe a
Nothing
      rcvCallInvitation :: (Int64, Text, UTCTime, CallType, Maybe Key)
-> ReaderT ChatController IO (Either ChatError RcvCallInvitation)
rcvCallInvitation (Int64
contactId, Text
callUUID, UTCTime
callTs, CallType
peerCallType, Maybe Key
sharedKey) = ExceptT ChatError (ReaderT ChatController IO) RcvCallInvitation
-> ReaderT ChatController IO (Either ChatError RcvCallInvitation)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError (ReaderT ChatController IO) RcvCallInvitation
 -> ReaderT ChatController IO (Either ChatError RcvCallInvitation))
-> ((Connection -> ExceptT StoreError IO RcvCallInvitation)
    -> ExceptT ChatError (ReaderT ChatController IO) RcvCallInvitation)
-> (Connection -> ExceptT StoreError IO RcvCallInvitation)
-> ReaderT ChatController IO (Either ChatError RcvCallInvitation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> ExceptT StoreError IO RcvCallInvitation)
-> ExceptT ChatError (ReaderT ChatController IO) RcvCallInvitation
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO RcvCallInvitation)
 -> ReaderT ChatController IO (Either ChatError RcvCallInvitation))
-> (Connection -> ExceptT StoreError IO RcvCallInvitation)
-> ReaderT ChatController IO (Either ChatError RcvCallInvitation)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        User
user <- Connection -> Int64 -> ExceptT StoreError IO User
getUserByContactId Connection
db Int64
contactId
        Contact
contact <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
        RcvCallInvitation -> ExceptT StoreError IO RcvCallInvitation
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RcvCallInvitation {User
user :: User
user :: User
user, Contact
contact :: Contact
contact :: Contact
contact, callType :: CallType
callType = CallType
peerCallType, Maybe Key
sharedKey :: Maybe Key
sharedKey :: Maybe Key
sharedKey, Text
callUUID :: Text
callUUID :: Text
callUUID, UTCTime
callTs :: UTCTime
callTs :: UTCTime
callTs}
  APICallStatus Int64
contactId WebRTCCallStatus
receivedStatus ->
    Int64
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
withCurrentCall Int64
contactId ((User
  -> Contact
  -> Call
  -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
 -> CM ChatResponse)
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user Contact
ct Call
call ->
      User
-> Contact
-> Call
-> WebRTCCallStatus
-> Maybe Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateCallItemStatus User
user Contact
ct Call
call WebRTCCallStatus
receivedStatus Maybe Int64
forall a. Maybe a
Nothing ExceptT ChatError (ReaderT ChatController IO) ()
-> Maybe Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Call -> Maybe Call
forall a. a -> Maybe a
Just Call
call
  APIUpdateProfile Int64
userId Profile
profile -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId (User -> Profile -> CM ChatResponse
`updateProfile` Profile
profile)
  APISetContactPrefs Int64
contactId Preferences
prefs' -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    User -> Contact -> Preferences -> CM ChatResponse
updateContactPrefs User
user Contact
ct Preferences
prefs'
  APISetContactAlias Int64
contactId Text
localAlias -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Contact
ct <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
      IO Contact -> ExceptT StoreError IO Contact
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Contact -> ExceptT StoreError IO Contact)
-> IO Contact -> ExceptT StoreError IO Contact
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> Contact -> Text -> IO Contact
updateContactAlias Connection
db Int64
userId Contact
ct Text
localAlias
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRContactAliasUpdated User
user Contact
ct'
  APISetGroupAlias Int64
gId Text
localAlias -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    GroupInfo
gInfo' <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId
      IO GroupInfo -> ExceptT StoreError IO GroupInfo
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GroupInfo -> ExceptT StoreError IO GroupInfo)
-> IO GroupInfo -> ExceptT StoreError IO GroupInfo
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> GroupInfo -> Text -> IO GroupInfo
updateGroupAlias Connection
db Int64
userId GroupInfo
gInfo Text
localAlias
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> ChatResponse
CRGroupAliasUpdated User
user GroupInfo
gInfo'
  APISetConnectionAlias Int64
connId Text
localAlias -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    PendingContactConnection
conn' <- (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      PendingContactConnection
conn <- Connection
-> Int64 -> Int64 -> ExceptT StoreError IO PendingContactConnection
getPendingContactConnection Connection
db Int64
userId Int64
connId
      IO PendingContactConnection
-> ExceptT StoreError IO PendingContactConnection
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PendingContactConnection
 -> ExceptT StoreError IO PendingContactConnection)
-> IO PendingContactConnection
-> ExceptT StoreError IO PendingContactConnection
forall a b. (a -> b) -> a -> b
$ Connection
-> Int64
-> PendingContactConnection
-> Text
-> IO PendingContactConnection
updateContactConnectionAlias Connection
db Int64
userId PendingContactConnection
conn Text
localAlias
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> PendingContactConnection -> ChatResponse
CRConnectionAliasUpdated User
user PendingContactConnection
conn'
  APISetUserUIThemes Int64
uId Maybe UIThemeEntityOverrides
uiThemes -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    user' :: User
user'@User {userId :: User -> Int64
userId = Int64
uId'} <- (Connection -> ExceptT StoreError IO User) -> CM User
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO User) -> CM User)
-> (Connection -> ExceptT StoreError IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      User
user' <- Connection -> Int64 -> ExceptT StoreError IO User
getUser Connection
db Int64
uId
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Maybe UIThemeEntityOverrides -> IO ()
setUserUIThemes Connection
db User
user Maybe UIThemeEntityOverrides
uiThemes
      User -> ExceptT StoreError IO User
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure User
user'
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
userId Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
uId') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (ChatController -> TVar (Maybe User))
-> Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar (Maybe User)
currentUser (Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Maybe User
forall a. a -> Maybe a
Just (User
user :: User) {uiThemes}
    User -> CM ChatResponse
ok User
user'
  APISetChatUIThemes (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) Maybe UIThemeEntityOverrides
uiThemes -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
cType of
    ChatType
CTDirect -> do
      (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        Contact
ct <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User -> Contact -> Maybe UIThemeEntityOverrides -> IO ()
setContactUIThemes Connection
db User
user Contact
ct Maybe UIThemeEntityOverrides
uiThemes
      User -> CM ChatResponse
ok User
user
    ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope -> do
      (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        GroupInfo
g <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User -> GroupInfo -> Maybe UIThemeEntityOverrides -> IO ()
setGroupUIThemes Connection
db User
user GroupInfo
g Maybe UIThemeEntityOverrides
uiThemes
      User -> CM ChatResponse
ok User
user
    ChatType
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  ChatCommand
APIGetNtfToken -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
-> ChatResponse
crNtfToken ((DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 -> ChatResponse)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient
 -> ExceptT
      AgentErrorType
      IO
      (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent AgentClient
-> ExceptT
     AgentErrorType
     IO
     (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
getNtfToken
  APIRegisterToken DeviceToken
token NotificationsMode
mode -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ ->
    NtfTknStatus -> ChatResponse
CRNtfTokenStatus (NtfTknStatus -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) NtfTknStatus
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> ExceptT AgentErrorType IO NtfTknStatus)
-> ExceptT ChatError (ReaderT ChatController IO) NtfTknStatus
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> NetworkRequestMode
-> DeviceToken
-> NotificationsMode
-> ExceptT AgentErrorType IO NtfTknStatus
registerNtfToken AgentClient
a NetworkRequestMode
nm DeviceToken
token NotificationsMode
mode)
  APIVerifyToken DeviceToken
token CbNonce
nonce ByteString
code -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> NetworkRequestMode
-> DeviceToken
-> CbNonce
-> ByteString
-> ExceptT AgentErrorType IO ()
verifyNtfToken AgentClient
a NetworkRequestMode
nm DeviceToken
token CbNonce
nonce ByteString
code) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  APICheckToken DeviceToken
token -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ ->
    NtfTknStatus -> ChatResponse
CRNtfTokenStatus (NtfTknStatus -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) NtfTknStatus
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> ExceptT AgentErrorType IO NtfTknStatus)
-> ExceptT ChatError (ReaderT ChatController IO) NtfTknStatus
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> NetworkRequestMode
-> DeviceToken
-> ExceptT AgentErrorType IO NtfTknStatus
checkNtfToken AgentClient
a NetworkRequestMode
nm DeviceToken
token)
  APIDeleteToken DeviceToken
token -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (AgentClient -> DeviceToken -> ExceptT AgentErrorType IO ()
`deleteNtfToken` DeviceToken
token) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  APIGetNtfConns CbNonce
nonce ByteString
encNtfInfo -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> do
    NonEmpty NotificationInfo
ntfInfos <- (AgentClient
 -> ExceptT AgentErrorType IO (NonEmpty NotificationInfo))
-> CM (NonEmpty NotificationInfo)
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT AgentErrorType IO (NonEmpty NotificationInfo))
 -> CM (NonEmpty NotificationInfo))
-> (AgentClient
    -> ExceptT AgentErrorType IO (NonEmpty NotificationInfo))
-> CM (NonEmpty NotificationInfo)
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> CbNonce
-> ByteString
-> ExceptT AgentErrorType IO (NonEmpty NotificationInfo)
getNotificationConns AgentClient
a CbNonce
nonce ByteString
encNtfInfo
    ([ChatError]
errs, [Maybe NtfConn]
ntfMsgs) <- ReaderT ChatController IO ([ChatError], [Maybe NtfConn])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [Maybe NtfConn])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [Maybe NtfConn])
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      ([ChatError], [Maybe NtfConn]))
-> ReaderT ChatController IO ([ChatError], [Maybe NtfConn])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [Maybe NtfConn])
forall a b. (a -> b) -> a -> b
$ [Either ChatError (Maybe NtfConn)]
-> ([ChatError], [Maybe NtfConn])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError (Maybe NtfConn)]
 -> ([ChatError], [Maybe NtfConn]))
-> ReaderT ChatController IO [Either ChatError (Maybe NtfConn)]
-> ReaderT ChatController IO ([ChatError], [Maybe NtfConn])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO (Maybe NtfConn)])
-> ReaderT ChatController IO [Either ChatError (Maybe NtfConn)]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO a)) -> CM' (t (Either ChatError a))
withStoreBatch' (\Connection
db -> (NotificationInfo -> IO (Maybe NtfConn))
-> [NotificationInfo] -> [IO (Maybe NtfConn)]
forall a b. (a -> b) -> [a] -> [b]
map (Connection -> NotificationInfo -> IO (Maybe NtfConn)
getMsgConn Connection
db) (NonEmpty NotificationInfo -> [NotificationInfo]
forall a. NonEmpty a -> [a]
L.toList NonEmpty NotificationInfo
ntfInfos))
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ [NtfConn] -> ChatResponse
CRNtfConns ([NtfConn] -> ChatResponse) -> [NtfConn] -> ChatResponse
forall a b. (a -> b) -> a -> b
$ [Maybe NtfConn] -> [NtfConn]
forall a. [Maybe a] -> [a]
catMaybes [Maybe NtfConn]
ntfMsgs
    where
      getMsgConn :: DB.Connection -> NotificationInfo -> IO (Maybe NtfConn)
      getMsgConn :: Connection -> NotificationInfo -> IO (Maybe NtfConn)
getMsgConn Connection
db NotificationInfo {ByteString
ntfConnId :: ByteString
ntfConnId :: NotificationInfo -> ByteString
ntfConnId, Int64
ntfDbQueueId :: Int64
ntfDbQueueId :: NotificationInfo -> Int64
ntfDbQueueId, ntfMsgMeta :: NotificationInfo -> Maybe NMsgMeta
ntfMsgMeta = Maybe NMsgMeta
nMsgMeta} = do
        let agentConnId :: AgentConnId
agentConnId = ByteString -> AgentConnId
AgentConnId ByteString
ntfConnId
            mkNtfConn :: User -> ConnectionEntity -> NtfConn
mkNtfConn User
user ConnectionEntity
connEntity = NtfConn {User
user :: User
user :: User
user, AgentConnId
agentConnId :: AgentConnId
agentConnId :: AgentConnId
agentConnId, agentDbQueueId :: Int64
agentDbQueueId = Int64
ntfDbQueueId, ConnectionEntity
connEntity :: ConnectionEntity
connEntity :: ConnectionEntity
connEntity, expectedMsg_ :: Maybe NtfMsgInfo
expectedMsg_ = NMsgMeta -> NtfMsgInfo
expectedMsgInfo (NMsgMeta -> NtfMsgInfo) -> Maybe NMsgMeta -> Maybe NtfMsgInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NMsgMeta
nMsgMeta}
        Connection -> AgentConnId -> IO (Maybe User)
getUserByAConnId Connection
db AgentConnId
agentConnId
          IO (Maybe User)
-> (User -> IO (Maybe NtfConn)) -> IO (Maybe NtfConn)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Monad f, Traversable f) =>
m (f a) -> (a -> m (f b)) -> m (f b)
$>>= \User
user -> (ConnectionEntity -> NtfConn)
-> Maybe ConnectionEntity -> Maybe NtfConn
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (User -> ConnectionEntity -> NtfConn
mkNtfConn User
user) (Maybe ConnectionEntity -> Maybe NtfConn)
-> (Either StoreError ConnectionEntity -> Maybe ConnectionEntity)
-> Either StoreError ConnectionEntity
-> Maybe NtfConn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either StoreError ConnectionEntity -> Maybe ConnectionEntity
forall a b. Either a b -> Maybe b
eitherToMaybe (Either StoreError ConnectionEntity -> Maybe NtfConn)
-> IO (Either StoreError ConnectionEntity) -> IO (Maybe NtfConn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT StoreError IO ConnectionEntity
-> IO (Either StoreError ConnectionEntity)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Connection
-> VersionRangeChat
-> User
-> AgentConnId
-> ExceptT StoreError IO ConnectionEntity
getConnectionEntity Connection
db VersionRangeChat
vr User
user AgentConnId
agentConnId)
  APIGetConnNtfMessages NonEmpty ConnMsgReq
connMsgs -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> do
    NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta))
msgs <- ReaderT
  ChatController
  IO
  (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta)))
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
   ChatController
   IO
   (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta)))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta))))
-> ReaderT
     ChatController
     IO
     (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta)))
forall a b. (a -> b) -> a -> b
$ (AgentClient
 -> IO (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta))))
-> ReaderT
     ChatController
     IO
     (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta)))
forall a. (AgentClient -> IO a) -> CM' a
withAgent' (AgentClient
-> NonEmpty ConnMsgReq
-> IO (NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta)))
`getConnectionMessages` NonEmpty ConnMsgReq
connMsgs)
    let ntfMsgs :: NonEmpty RcvNtfMsgInfo
ntfMsgs = (Either AgentErrorType (Maybe SMPMsgMeta) -> RcvNtfMsgInfo)
-> NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta))
-> NonEmpty RcvNtfMsgInfo
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map Either AgentErrorType (Maybe SMPMsgMeta) -> RcvNtfMsgInfo
receivedMsgInfo NonEmpty (Either AgentErrorType (Maybe SMPMsgMeta))
msgs
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ NonEmpty RcvNtfMsgInfo -> ChatResponse
CRConnNtfMessages NonEmpty RcvNtfMsgInfo
ntfMsgs
  GetUserProtoServers (AProtocolType SProtocolType p
p) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> SProtocolType p
-> (UserProtocol p => CM ChatResponse) -> CM ChatResponse
forall (p :: ProtocolType) a.
ProtocolTypeI p =>
SProtocolType p -> (UserProtocol p => CM a) -> CM a
withServerProtocol SProtocolType p
p ((UserProtocol p => CM ChatResponse) -> CM ChatResponse)
-> (UserProtocol p => CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
srvs <- (Connection
 -> ExceptT
      StoreError
      IO
      ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
-> CM
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection
-> User
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
`getUserServers` User
user)
    IO ChatResponse -> CM ChatResponse
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChatResponse -> CM ChatResponse)
-> IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [UserOperatorServers] -> ChatResponse
CRUserServers User
user ([UserOperatorServers] -> ChatResponse)
-> IO [UserOperatorServers] -> IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> IO [UserOperatorServers]
groupByOperator (SProtocolType p
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
protocolServers SProtocolType p
p ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
srvs)
  SetUserProtoServers (AProtocolType (SProtocolType p
p :: SProtocolType p)) [AProtoServerWithAuth]
srvs -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> SProtocolType p
-> (UserProtocol p => CM ChatResponse) -> CM ChatResponse
forall (p :: ProtocolType) a.
ProtocolTypeI p =>
SProtocolType p -> (UserProtocol p => CM a) -> CM a
withServerProtocol SProtocolType p
p ((UserProtocol p => CM ChatResponse) -> CM ChatResponse)
-> (UserProtocol p => CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    [UserOperatorServers]
userServers_ <- IO [UserOperatorServers]
-> ExceptT
     ChatError (ReaderT ChatController IO) [UserOperatorServers]
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UserOperatorServers]
 -> ExceptT
      ChatError (ReaderT ChatController IO) [UserOperatorServers])
-> (([Maybe ServerOperator], [UserServer 'PSMP],
     [UserServer 'PXFTP])
    -> IO [UserOperatorServers])
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
-> ExceptT
     ChatError (ReaderT ChatController IO) [UserOperatorServers]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> IO [UserOperatorServers]
groupByOperator (([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
 -> ExceptT
      ChatError (ReaderT ChatController IO) [UserOperatorServers])
-> CM
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> ExceptT
     ChatError (ReaderT ChatController IO) [UserOperatorServers]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Connection
 -> ExceptT
      StoreError
      IO
      ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]))
-> CM
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection
-> User
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
`getUserServers` User
user)
    case [UserOperatorServers] -> Maybe (NonEmpty UserOperatorServers)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [UserOperatorServers]
userServers_ of
      Maybe (NonEmpty UserOperatorServers)
Nothing -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"no servers"
      Just NonEmpty UserOperatorServers
userServers -> case [AProtoServerWithAuth]
srvs of
        [] -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"no servers"
        [AProtoServerWithAuth]
_ -> do
          [AUserServer p]
srvs' <- (AProtoServerWithAuth
 -> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p))
-> [AProtoServerWithAuth]
-> ExceptT ChatError (ReaderT ChatController IO) [AUserServer p]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AProtoServerWithAuth
-> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p)
aUserServer [AProtoServerWithAuth]
srvs
          VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> NonEmpty UpdatedUserOperatorServers -> ChatCommand
APISetUserServers Int64
userId (NonEmpty UpdatedUserOperatorServers -> ChatCommand)
-> NonEmpty UpdatedUserOperatorServers -> ChatCommand
forall a b. (a -> b) -> a -> b
$ (UserOperatorServers -> UpdatedUserOperatorServers)
-> NonEmpty UserOperatorServers
-> NonEmpty UpdatedUserOperatorServers
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map (SProtocolType p
-> [AUserServer p]
-> UserOperatorServers
-> UpdatedUserOperatorServers
forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> [AUserServer p]
-> UserOperatorServers
-> UpdatedUserOperatorServers
updatedServers SProtocolType p
p [AUserServer p]
srvs') NonEmpty UserOperatorServers
userServers
    where
      aUserServer :: AProtoServerWithAuth -> CM (AUserServer p)
      aUserServer :: AProtoServerWithAuth
-> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p)
aUserServer (AProtoServerWithAuth SProtocolType p
p' ProtoServerWithAuth p
srv) = case SProtocolType p -> SProtocolType p -> Maybe (p :~: p)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: ProtocolType) (b :: ProtocolType).
SProtocolType a -> SProtocolType b -> Maybe (a :~: b)
testEquality SProtocolType p
p SProtocolType p
p' of
        Just p :~: p
Refl -> AUserServer p
-> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AUserServer p
 -> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p))
-> AUserServer p
-> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p)
forall a b. (a -> b) -> a -> b
$ SDBStored 'DBNew -> UserServer' 'DBNew p -> AUserServer p
forall (p :: ProtocolType) (s :: DBStored).
SDBStored s -> UserServer' s p -> AUserServer p
AUS SDBStored 'DBNew
SDBNew (UserServer' 'DBNew p -> AUserServer p)
-> UserServer' 'DBNew p -> AUserServer p
forall a b. (a -> b) -> a -> b
$ ProtoServerWithAuth p -> UserServer' 'DBNew p
forall (p :: ProtocolType).
ProtoServerWithAuth p -> NewUserServer p
newUserServer ProtoServerWithAuth p
ProtoServerWithAuth p
srv
        Maybe (p :~: p)
Nothing -> String
-> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p)
forall a. String -> CM a
throwCmdError (String
 -> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p))
-> String
-> ExceptT ChatError (ReaderT ChatController IO) (AUserServer p)
forall a b. (a -> b) -> a -> b
$ String
"incorrect server protocol: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
B.unpack (ProtoServerWithAuth p -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ProtoServerWithAuth p
srv)
  APITestProtoServer Int64
userId srv :: AProtoServerWithAuth
srv@(AProtoServerWithAuth SProtocolType p
_ ProtoServerWithAuth p
server) -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> AProtoServerWithAuth
-> Maybe ProtocolTestFailure
-> ChatResponse
CRServerTestResult User
user AProtoServerWithAuth
srv (Maybe ProtocolTestFailure -> ChatResponse)
-> ReaderT ChatController IO (Maybe ProtocolTestFailure)
-> ReaderT ChatController IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> IO (Maybe ProtocolTestFailure))
-> ReaderT ChatController IO (Maybe ProtocolTestFailure)
forall a. (AgentClient -> IO a) -> CM' a
withAgent' (\AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> ProtoServerWithAuth p
-> IO (Maybe ProtocolTestFailure)
forall (p :: ProtocolType).
ProtocolTypeI p =>
AgentClient
-> NetworkRequestMode
-> Int64
-> ProtoServerWithAuth p
-> IO (Maybe ProtocolTestFailure)
testProtocolServer AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) ProtoServerWithAuth p
server)
  TestProtoServer AProtoServerWithAuth
srv -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> AProtoServerWithAuth -> ChatCommand
APITestProtoServer Int64
userId AProtoServerWithAuth
srv
  ChatCommand
APIGetServerOperators -> ServerOperatorConditions -> ChatResponse
CRServerOperatorConditions (ServerOperatorConditions -> ChatResponse)
-> ExceptT
     ChatError (ReaderT ChatController IO) ServerOperatorConditions
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO ServerOperatorConditions)
-> ExceptT
     ChatError (ReaderT ChatController IO) ServerOperatorConditions
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore Connection -> ExceptT StoreError IO ServerOperatorConditions
getServerOperators
  APISetServerOperators NonEmpty ServerOperator
operators -> do
    RandomAgentServers
as <- (ChatController -> RandomAgentServers)
-> ExceptT ChatError (ReaderT ChatController IO) RandomAgentServers
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> RandomAgentServers
randomAgentServers
    (ServerOperatorConditions
opsConds, [(Int64,
  (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]
srvs) <- (Connection
 -> ExceptT
      StoreError
      IO
      (ServerOperatorConditions,
       [(Int64,
         (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
-> CM
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError
       IO
       (ServerOperatorConditions,
        [(Int64,
          (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
 -> CM
      (ServerOperatorConditions,
       [(Int64,
         (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
-> (Connection
    -> ExceptT
         StoreError
         IO
         (ServerOperatorConditions,
          [(Int64,
            (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
-> CM
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> NonEmpty ServerOperator -> IO ()
setServerOperators Connection
db NonEmpty ServerOperator
operators
      ServerOperatorConditions
opsConds <- Connection -> ExceptT StoreError IO ServerOperatorConditions
getServerOperators Connection
db
      let ops :: [ServerOperator]
ops = ServerOperatorConditions -> [ServerOperator]
serverOperators ServerOperatorConditions
opsConds
          ops' :: [Maybe ServerOperator]
ops' = (ServerOperator -> Maybe ServerOperator)
-> [ServerOperator] -> [Maybe ServerOperator]
forall a b. (a -> b) -> [a] -> [b]
map ServerOperator -> Maybe ServerOperator
forall a. a -> Maybe a
Just [ServerOperator]
ops [Maybe ServerOperator]
-> [Maybe ServerOperator] -> [Maybe ServerOperator]
forall a. Semigroup a => a -> a -> a
<> [Maybe ServerOperator
Item [Maybe ServerOperator]
forall a. Maybe a
Nothing]
          opDomains :: [(Text, ServerOperator)]
opDomains = [ServerOperator] -> [(Text, ServerOperator)]
forall (s :: DBStored).
[ServerOperator' s] -> [(Text, ServerOperator' s)]
operatorDomains [ServerOperator]
ops
      IO
  (ServerOperatorConditions,
   [(Int64,
     (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
-> ExceptT
     StoreError
     IO
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (ServerOperatorConditions,
    [(Int64,
      (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
 -> ExceptT
      StoreError
      IO
      (ServerOperatorConditions,
       [(Int64,
         (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
-> IO
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
-> ExceptT
     StoreError
     IO
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
forall a b. (a -> b) -> a -> b
$ ([(Int64,
   (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]
 -> (ServerOperatorConditions,
     [(Int64,
       (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
-> IO
     [(Int64,
       (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]
-> IO
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ServerOperatorConditions
opsConds,) (IO
   [(Int64,
     (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]
 -> IO
      (ServerOperatorConditions,
       [(Int64,
         (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
-> ([User]
    -> IO
         [(Int64,
           (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
-> [User]
-> IO
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (User
 -> IO
      (Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))))
-> [User]
-> IO
     [(Int64,
       (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> RandomAgentServers
-> [Maybe ServerOperator]
-> [(Text, ServerOperator)]
-> User
-> IO
     (Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
getServers Connection
db RandomAgentServers
as [Maybe ServerOperator]
ops' [(Text, ServerOperator)]
opDomains) ([User]
 -> IO
      (ServerOperatorConditions,
       [(Int64,
         (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]))
-> IO [User]
-> IO
     (ServerOperatorConditions,
      [(Int64,
        (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection -> IO [User]
getUsers Connection
db
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' ((AgentClient -> IO ()) -> ReaderT ChatController IO ())
-> (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> [(Int64,
  (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]
-> ((Int64,
     (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
    -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64,
  (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))]
srvs (((Int64,
   (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
  -> IO ())
 -> IO ())
-> ((Int64,
     (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int64
auId, (NonEmpty (ServerCfg 'PSMP)
smp', NonEmpty (ServerCfg 'PXFTP)
xftp')) -> do
      AgentClient -> Int64 -> NonEmpty (ServerCfg 'PSMP) -> IO ()
forall (p :: ProtocolType).
(ProtocolTypeI p, UserProtocol p) =>
AgentClient -> Int64 -> NonEmpty (ServerCfg p) -> IO ()
setProtocolServers AgentClient
a Int64
auId NonEmpty (ServerCfg 'PSMP)
smp'
      AgentClient -> Int64 -> NonEmpty (ServerCfg 'PXFTP) -> IO ()
forall (p :: ProtocolType).
(ProtocolTypeI p, UserProtocol p) =>
AgentClient -> Int64 -> NonEmpty (ServerCfg p) -> IO ()
setProtocolServers AgentClient
a Int64
auId NonEmpty (ServerCfg 'PXFTP)
xftp'
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ServerOperatorConditions -> ChatResponse
CRServerOperatorConditions ServerOperatorConditions
opsConds
    where
      getServers :: DB.Connection -> RandomAgentServers -> [Maybe ServerOperator] -> [(Text, ServerOperator)] -> User -> IO (UserId, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
      getServers :: Connection
-> RandomAgentServers
-> [Maybe ServerOperator]
-> [(Text, ServerOperator)]
-> User
-> IO
     (Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
getServers Connection
db RandomAgentServers
as [Maybe ServerOperator]
ops [(Text, ServerOperator)]
opDomains User
user = do
        [UserServer 'PSMP]
smpSrvs <- Connection -> SProtocolType 'PSMP -> User -> IO [UserServer 'PSMP]
forall (p :: ProtocolType).
ProtocolTypeI p =>
Connection -> SProtocolType p -> User -> IO [UserServer p]
getProtocolServers Connection
db SProtocolType 'PSMP
SPSMP User
user
        [UserServer 'PXFTP]
xftpSrvs <- Connection
-> SProtocolType 'PXFTP -> User -> IO [UserServer 'PXFTP]
forall (p :: ProtocolType).
ProtocolTypeI p =>
Connection -> SProtocolType p -> User -> IO [UserServer p]
getProtocolServers Connection
db SProtocolType 'PXFTP
SPXFTP User
user
        [UserOperatorServers]
uss <- ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> IO [UserOperatorServers]
groupByOperator ([Maybe ServerOperator]
ops, [UserServer 'PSMP]
smpSrvs, [UserServer 'PXFTP]
xftpSrvs)
        (Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
-> IO
     (Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
 -> IO
      (Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))))
-> (Int64,
    (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
-> IO
     (Int64, (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a b. (a -> b) -> a -> b
$ (User -> Int64
aUserId User
user,) ((NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
 -> (Int64,
     (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))))
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
-> (Int64,
    (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP)))
forall a b. (a -> b) -> a -> b
$ RandomAgentServers
-> [(Text, ServerOperator)]
-> [UserOperatorServers]
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
forall (f :: * -> *).
Foldable f =>
RandomAgentServers
-> [(Text, ServerOperator)]
-> f UserOperatorServers
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
useServers RandomAgentServers
as [(Text, ServerOperator)]
opDomains [UserOperatorServers]
uss
  SetServerOperators NonEmpty ServerOperatorRoles
operatorsRoles -> do
    [ServerOperator]
ops <- ServerOperatorConditions -> [ServerOperator]
serverOperators (ServerOperatorConditions -> [ServerOperator])
-> ExceptT
     ChatError (ReaderT ChatController IO) ServerOperatorConditions
-> ExceptT ChatError (ReaderT ChatController IO) [ServerOperator]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO ServerOperatorConditions)
-> ExceptT
     ChatError (ReaderT ChatController IO) ServerOperatorConditions
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore Connection -> ExceptT StoreError IO ServerOperatorConditions
getServerOperators
    NonEmpty ServerOperator
ops' <- (ServerOperatorRoles
 -> ExceptT ChatError (ReaderT ChatController IO) ServerOperator)
-> NonEmpty ServerOperatorRoles
-> ExceptT
     ChatError (ReaderT ChatController IO) (NonEmpty ServerOperator)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM ([ServerOperator]
-> ServerOperatorRoles
-> ExceptT ChatError (ReaderT ChatController IO) ServerOperator
updateOp [ServerOperator]
ops) NonEmpty ServerOperatorRoles
operatorsRoles
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ NonEmpty ServerOperator -> ChatCommand
APISetServerOperators NonEmpty ServerOperator
ops'
    where
      updateOp :: [ServerOperator] -> ServerOperatorRoles -> CM ServerOperator
      updateOp :: [ServerOperator]
-> ServerOperatorRoles
-> ExceptT ChatError (ReaderT ChatController IO) ServerOperator
updateOp [ServerOperator]
ops ServerOperatorRoles
r =
        case (ServerOperator -> Bool)
-> [ServerOperator] -> Maybe ServerOperator
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ServerOperator {operatorId :: forall (s :: DBStored). ServerOperator' s -> DBEntityId' s
operatorId = DBEntityId Int64
opId} -> ServerOperatorRoles -> Int64
operatorId' ServerOperatorRoles
r Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
opId) [ServerOperator]
ops of
          Just ServerOperator
op -> ServerOperator
-> ExceptT ChatError (ReaderT ChatController IO) ServerOperator
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerOperator
op {enabled = enabled' r, smpRoles = smpRoles' r, xftpRoles = xftpRoles' r}
          Maybe ServerOperator
Nothing -> ChatError
-> ExceptT ChatError (ReaderT ChatController IO) ServerOperator
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ChatError
 -> ExceptT ChatError (ReaderT ChatController IO) ServerOperator)
-> ChatError
-> ExceptT ChatError (ReaderT ChatController IO) ServerOperator
forall a b. (a -> b) -> a -> b
$ StoreError -> ChatError
ChatErrorStore (StoreError -> ChatError) -> StoreError -> ChatError
forall a b. (a -> b) -> a -> b
$ Int64 -> StoreError
SEOperatorNotFound (Int64 -> StoreError) -> Int64 -> StoreError
forall a b. (a -> b) -> a -> b
$ ServerOperatorRoles -> Int64
operatorId' ServerOperatorRoles
r
  APIGetUserServers Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> (Connection -> ExceptT StoreError IO ChatResponse)
-> CM ChatResponse
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ChatResponse)
 -> CM ChatResponse)
-> (Connection -> ExceptT StoreError IO ChatResponse)
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
    User -> [UserOperatorServers] -> ChatResponse
CRUserServers User
user ([UserOperatorServers] -> ChatResponse)
-> ExceptT StoreError IO [UserOperatorServers]
-> ExceptT StoreError IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO [UserOperatorServers]
-> ExceptT StoreError IO [UserOperatorServers]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UserOperatorServers]
 -> ExceptT StoreError IO [UserOperatorServers])
-> (([Maybe ServerOperator], [UserServer 'PSMP],
     [UserServer 'PXFTP])
    -> IO [UserOperatorServers])
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
-> ExceptT StoreError IO [UserOperatorServers]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> IO [UserOperatorServers]
groupByOperator (([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
 -> ExceptT StoreError IO [UserOperatorServers])
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> ExceptT StoreError IO [UserOperatorServers]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> User
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
getUserServers Connection
db User
user)
  APISetUserServers Int64
userId NonEmpty UpdatedUserOperatorServers
userServers -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [UserServersError]
errors <- Int64 -> [UpdatedUserOperatorServers] -> CM [UserServersError]
forall u.
UserServersClass u =>
Int64 -> [u] -> CM [UserServersError]
validateAllUsersServers Int64
userId ([UpdatedUserOperatorServers] -> CM [UserServersError])
-> [UpdatedUserOperatorServers] -> CM [UserServersError]
forall a b. (a -> b) -> a -> b
$ NonEmpty UpdatedUserOperatorServers -> [UpdatedUserOperatorServers]
forall a. NonEmpty a -> [a]
L.toList NonEmpty UpdatedUserOperatorServers
userServers
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([UserServersError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UserServersError]
errors) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String
"user servers validation error(s): " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [UserServersError] -> String
forall a. Show a => a -> String
show [UserServersError]
errors
    NonEmpty UserOperatorServers
uss <- (Connection
 -> ExceptT StoreError IO (NonEmpty UserOperatorServers))
-> CM (NonEmpty UserOperatorServers)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (NonEmpty UserOperatorServers))
 -> CM (NonEmpty UserOperatorServers))
-> (Connection
    -> ExceptT StoreError IO (NonEmpty UserOperatorServers))
-> CM (NonEmpty UserOperatorServers)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      UTCTime
ts <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      (UpdatedUserOperatorServers
 -> ExceptT StoreError IO UserOperatorServers)
-> NonEmpty UpdatedUserOperatorServers
-> ExceptT StoreError IO (NonEmpty UserOperatorServers)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (Connection
-> User
-> UTCTime
-> UpdatedUserOperatorServers
-> ExceptT StoreError IO UserOperatorServers
setUserServers Connection
db User
user UTCTime
ts) NonEmpty UpdatedUserOperatorServers
userServers
    RandomAgentServers
as <- (ChatController -> RandomAgentServers)
-> ExceptT ChatError (ReaderT ChatController IO) RandomAgentServers
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> RandomAgentServers
randomAgentServers
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' ((AgentClient -> IO ()) -> ReaderT ChatController IO ())
-> (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> do
      let auId :: Int64
auId = User -> Int64
aUserId User
user
          opDomains :: [(Text, ServerOperator)]
opDomains = [ServerOperator] -> [(Text, ServerOperator)]
forall (s :: DBStored).
[ServerOperator' s] -> [(Text, ServerOperator' s)]
operatorDomains ([ServerOperator] -> [(Text, ServerOperator)])
-> [ServerOperator] -> [(Text, ServerOperator)]
forall a b. (a -> b) -> a -> b
$ (UserOperatorServers -> Maybe ServerOperator)
-> [UserOperatorServers] -> [ServerOperator]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe UserOperatorServers -> Maybe ServerOperator
forall u. UserServersClass u => u -> Maybe ServerOperator
operator' ([UserOperatorServers] -> [ServerOperator])
-> [UserOperatorServers] -> [ServerOperator]
forall a b. (a -> b) -> a -> b
$ NonEmpty UserOperatorServers -> [UserOperatorServers]
forall a. NonEmpty a -> [a]
L.toList NonEmpty UserOperatorServers
uss
          (NonEmpty (ServerCfg 'PSMP)
smp', NonEmpty (ServerCfg 'PXFTP)
xftp') = RandomAgentServers
-> [(Text, ServerOperator)]
-> NonEmpty UserOperatorServers
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
forall (f :: * -> *).
Foldable f =>
RandomAgentServers
-> [(Text, ServerOperator)]
-> f UserOperatorServers
-> (NonEmpty (ServerCfg 'PSMP), NonEmpty (ServerCfg 'PXFTP))
useServers RandomAgentServers
as [(Text, ServerOperator)]
opDomains NonEmpty UserOperatorServers
uss
      AgentClient -> Int64 -> NonEmpty (ServerCfg 'PSMP) -> IO ()
forall (p :: ProtocolType).
(ProtocolTypeI p, UserProtocol p) =>
AgentClient -> Int64 -> NonEmpty (ServerCfg p) -> IO ()
setProtocolServers AgentClient
a Int64
auId NonEmpty (ServerCfg 'PSMP)
smp'
      AgentClient -> Int64 -> NonEmpty (ServerCfg 'PXFTP) -> IO ()
forall (p :: ProtocolType).
(ProtocolTypeI p, UserProtocol p) =>
AgentClient -> Int64 -> NonEmpty (ServerCfg p) -> IO ()
setProtocolServers AgentClient
a Int64
auId NonEmpty (ServerCfg 'PXFTP)
xftp'
    CM ChatResponse
ok_
  APIValidateServers Int64
userId [UpdatedUserOperatorServers]
userServers -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> [UserServersError] -> ChatResponse
CRUserServersValidation User
user ([UserServersError] -> ChatResponse)
-> CM [UserServersError] -> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> [UpdatedUserOperatorServers] -> CM [UserServersError]
forall u.
UserServersClass u =>
Int64 -> [u] -> CM [UserServersError]
validateAllUsersServers Int64
userId [UpdatedUserOperatorServers]
userServers
  ChatCommand
APIGetUsageConditions -> do
    (UsageConditions
usageConditions, Maybe UsageConditions
acceptedConditions) <- (Connection
 -> ExceptT StoreError IO (UsageConditions, Maybe UsageConditions))
-> CM (UsageConditions, Maybe UsageConditions)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (UsageConditions, Maybe UsageConditions))
 -> CM (UsageConditions, Maybe UsageConditions))
-> (Connection
    -> ExceptT StoreError IO (UsageConditions, Maybe UsageConditions))
-> CM (UsageConditions, Maybe UsageConditions)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      UsageConditions
usageConditions <- Connection -> ExceptT StoreError IO UsageConditions
getCurrentUsageConditions Connection
db
      Maybe UsageConditions
acceptedConditions <- IO (Maybe UsageConditions)
-> ExceptT StoreError IO (Maybe UsageConditions)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UsageConditions)
 -> ExceptT StoreError IO (Maybe UsageConditions))
-> IO (Maybe UsageConditions)
-> ExceptT StoreError IO (Maybe UsageConditions)
forall a b. (a -> b) -> a -> b
$ Connection -> IO (Maybe UsageConditions)
getLatestAcceptedConditions Connection
db
      (UsageConditions, Maybe UsageConditions)
-> ExceptT StoreError IO (UsageConditions, Maybe UsageConditions)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UsageConditions
usageConditions, Maybe UsageConditions
acceptedConditions)
    -- TODO if db commit is different from source commit, conditionsText should be nothing in response
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      CRUsageConditions
        { UsageConditions
usageConditions :: UsageConditions
usageConditions :: UsageConditions
usageConditions,
          conditionsText :: Text
conditionsText = Text
usageConditionsText,
          Maybe UsageConditions
acceptedConditions :: Maybe UsageConditions
acceptedConditions :: Maybe UsageConditions
acceptedConditions
        }
  APISetConditionsNotified Int64
condId -> do
    UTCTime
currentTs <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> UTCTime -> IO ()
setConditionsNotified Connection
db Int64
condId UTCTime
currentTs
    CM ChatResponse
ok_
  APIAcceptConditions Int64
condId NonEmpty Int64
opIds -> (Connection -> ExceptT StoreError IO ChatResponse)
-> CM ChatResponse
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ChatResponse)
 -> CM ChatResponse)
-> (Connection -> ExceptT StoreError IO ChatResponse)
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
    UTCTime
currentTs <- IO UTCTime -> ExceptT StoreError IO UTCTime
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    Connection
-> Int64 -> NonEmpty Int64 -> UTCTime -> ExceptT StoreError IO ()
acceptConditions Connection
db Int64
condId NonEmpty Int64
opIds UTCTime
currentTs
    ServerOperatorConditions -> ChatResponse
CRServerOperatorConditions (ServerOperatorConditions -> ChatResponse)
-> ExceptT StoreError IO ServerOperatorConditions
-> ExceptT StoreError IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ExceptT StoreError IO ServerOperatorConditions
getServerOperators Connection
db
  APISetChatTTL Int64
userId (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) Maybe Int64
newTTL_ ->
    Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> CM ChatResponse -> CM ChatResponse
checkStoreNotChanged (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Text -> CM ChatResponse -> CM ChatResponse
forall a. Text -> CM a -> CM a
withChatLock Text
"setChatTTL" (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      (Maybe Int64
oldTTL_, Int64
globalTTL, Int
ttlCount) <- (Connection -> IO (Maybe Int64, Int64, Int))
-> CM (Maybe Int64, Int64, Int)
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO (Maybe Int64, Int64, Int))
 -> CM (Maybe Int64, Int64, Int))
-> (Connection -> IO (Maybe Int64, Int64, Int))
-> CM (Maybe Int64, Int64, Int)
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
        (,,) (Maybe Int64 -> Int64 -> Int -> (Maybe Int64, Int64, Int))
-> IO (Maybe Int64)
-> IO (Int64 -> Int -> (Maybe Int64, Int64, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe Int64)
getSetChatTTL Connection
db IO (Int64 -> Int -> (Maybe Int64, Int64, Int))
-> IO Int64 -> IO (Int -> (Maybe Int64, Int64, Int))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> User -> IO Int64
getChatItemTTL Connection
db User
user IO (Int -> (Maybe Int64, Int64, Int))
-> IO Int -> IO (Maybe Int64, Int64, Int)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> User -> IO Int
getChatTTLCount Connection
db User
user
      let newTTL :: Int64
newTTL = Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
globalTTL Maybe Int64
newTTL_
          oldTTL :: Int64
oldTTL = Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
globalTTL Maybe Int64
oldTTL_
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
newTTL Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
&& (Int64
newTTL Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
oldTTL Bool -> Bool -> Bool
|| Int64
oldTTL Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0)) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
        ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Bool -> ReaderT ChatController IO ()
setExpireCIFlag User
user Bool
False
        User -> Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
expireChat User
user Int64
globalTTL ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Int64 -> Int -> ReaderT ChatController IO ()
setChatItemsExpiration User
user Int64
globalTTL Int
ttlCount
      User -> CM ChatResponse
ok User
user
    where
      getSetChatTTL :: Connection -> IO (Maybe Int64)
getSetChatTTL Connection
db = case ChatType
cType of
        ChatType
CTDirect -> Connection -> Int64 -> IO (Maybe Int64)
getDirectChatTTL Connection
db Int64
chatId IO (Maybe Int64) -> IO () -> IO (Maybe Int64)
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Connection -> Int64 -> Maybe Int64 -> IO ()
setDirectChatTTL Connection
db Int64
chatId Maybe Int64
newTTL_
        ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope -> Connection -> Int64 -> IO (Maybe Int64)
getGroupChatTTL Connection
db Int64
chatId IO (Maybe Int64) -> IO () -> IO (Maybe Int64)
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Connection -> Int64 -> Maybe Int64 -> IO ()
setGroupChatTTL Connection
db Int64
chatId Maybe Int64
newTTL_
        ChatType
_ -> Maybe Int64 -> IO (Maybe Int64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int64
forall a. Maybe a
Nothing
      expireChat :: User -> Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
expireChat User
user Int64
globalTTL = do
        UTCTime
currentTs <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        case ChatType
cType of
          ChatType
CTDirect -> User
-> VersionRangeChat
-> Int64
-> Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireContactChatItems User
user VersionRangeChat
vr Int64
globalTTL Int64
chatId
          ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope ->
            let createdAtCutoff :: UTCTime
createdAtCutoff = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
43200 :: NominalDiffTime) UTCTime
currentTs
              in User
-> VersionRangeChat
-> Int64
-> UTCTime
-> Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireGroupChatItems User
user VersionRangeChat
vr Int64
globalTTL UTCTime
createdAtCutoff Int64
chatId
          ChatType
_ -> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"not supported"
  SetChatTTL ChatName
chatName Maybe Int64
newTTL -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatRef -> Maybe Int64 -> ChatCommand
APISetChatTTL Int64
userId ChatRef
chatRef Maybe Int64
newTTL
  GetChatTTL ChatName
chatName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    -- TODO [knocking] support scope in CLI apis
    ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
_ <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    Maybe Int64
ttl <- case ChatType
cType of
      ChatType
CTDirect -> (Connection -> IO (Maybe Int64)) -> CM (Maybe Int64)
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> Int64 -> IO (Maybe Int64)
`getDirectChatTTL` Int64
chatId)
      ChatType
CTGroup -> (Connection -> IO (Maybe Int64)) -> CM (Maybe Int64)
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> Int64 -> IO (Maybe Int64)
`getGroupChatTTL` Int64
chatId)
      ChatType
_ -> String -> CM (Maybe Int64)
forall a. String -> CM a
throwCmdError String
"not supported"
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe Int64 -> ChatResponse
CRChatItemTTL User
user Maybe Int64
ttl
  APISetChatItemTTL Int64
userId Int64
newTTL -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    CM ChatResponse -> CM ChatResponse
checkStoreNotChanged (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
      Text -> CM ChatResponse -> CM ChatResponse
forall a. Text -> CM a -> CM a
withChatLock Text
"setChatItemTTL" (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
        (Int64
oldTTL, Int
ttlCount) <- (Connection -> IO (Int64, Int)) -> CM (Int64, Int)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (Int64, Int)) -> CM (Int64, Int))
-> (Connection -> IO (Int64, Int)) -> CM (Int64, Int)
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
          (,) (Int64 -> Int -> (Int64, Int))
-> IO Int64 -> IO (Int -> (Int64, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> IO Int64
getChatItemTTL Connection
db User
user IO (Int -> (Int64, Int)) -> IO () -> IO (Int -> (Int64, Int))
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Connection -> User -> Int64 -> IO ()
setChatItemTTL Connection
db User
user Int64
newTTL IO (Int -> (Int64, Int)) -> IO Int -> IO (Int64, Int)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> User -> IO Int
getChatTTLCount Connection
db User
user
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
newTTL Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
&& (Int64
newTTL Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
oldTTL Bool -> Bool -> Bool
|| Int64
oldTTL Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0)) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
          ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Bool -> ReaderT ChatController IO ()
setExpireCIFlag User
user Bool
False
          User
-> Int64
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireChatItems User
user Int64
newTTL Bool
True
        ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Int64 -> Int -> ReaderT ChatController IO ()
setChatItemsExpiration User
user Int64
newTTL Int
ttlCount
        User -> CM ChatResponse
ok User
user
  SetChatItemTTL Int64
newTTL_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> ChatCommand
APISetChatItemTTL Int64
userId Int64
newTTL_
  APIGetChatItemTTL Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId' Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
ttl <- (Connection -> IO Int64) -> CM Int64
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO Int64
`getChatItemTTL` User
user)
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe Int64 -> ChatResponse
CRChatItemTTL User
user (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
ttl)
  ChatCommand
GetChatItemTTL -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIGetChatItemTTL Int64
userId
  APISetNetworkConfig NetworkConfig
cfg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' (AgentClient -> NetworkConfig -> IO ()
`setNetworkConfig` NetworkConfig
cfg)) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ChatCommand
APIGetNetworkConfig -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ ->
    NetworkConfig -> ChatResponse
CRNetworkConfig (NetworkConfig -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) NetworkConfig
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ChatController IO NetworkConfig
-> ExceptT ChatError (ReaderT ChatController IO) NetworkConfig
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO NetworkConfig
getNetworkConfig
  SetNetworkConfig SimpleNetCfg
simpleNetCfg -> do
    NetworkConfig
cfg <- (NetworkConfig -> SimpleNetCfg -> NetworkConfig
`updateNetworkConfig` SimpleNetCfg
simpleNetCfg) (NetworkConfig -> NetworkConfig)
-> ExceptT ChatError (ReaderT ChatController IO) NetworkConfig
-> ExceptT ChatError (ReaderT ChatController IO) NetworkConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ChatController IO NetworkConfig
-> ExceptT ChatError (ReaderT ChatController IO) NetworkConfig
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO NetworkConfig
getNetworkConfig
    CM ChatResponse -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM ChatResponse
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatCommand -> CM ChatResponse)
-> ChatCommand
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatCommand -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ NetworkConfig -> ChatCommand
APISetNetworkConfig NetworkConfig
cfg
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ NetworkConfig -> ChatResponse
CRNetworkConfig NetworkConfig
cfg
  APISetNetworkInfo UserNetworkInfo
info -> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' (AgentClient -> UserNetworkInfo -> IO ()
`setUserNetworkInfo` UserNetworkInfo
info)) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ChatCommand
ReconnectAllServers -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO ()
reconnectAllServers) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ReconnectServer Int64
userId SMPServer
srv -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' ((AgentClient -> IO ()) -> ReaderT ChatController IO ())
-> (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient -> Int64 -> SMPServer -> IO ()
reconnectSMPServer AgentClient
a (User -> Int64
aUserId User
user) SMPServer
srv)
    CM ChatResponse
ok_
  APISetChatSettings (ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
scope) ChatSettings
chatSettings -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ChatType
cType of
    ChatType
CTDirect -> do
      Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        Contact
ct <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
chatId
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Int64 -> ChatSettings -> IO ()
updateContactSettings Connection
db User
user Int64
chatId ChatSettings
chatSettings
        Contact -> ExceptT StoreError IO Contact
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
ct
      Maybe ByteString
-> (ByteString -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Contact -> Maybe ByteString
contactConnId Contact
ct) ((ByteString -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ByteString -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \ByteString
connId ->
        (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient -> ByteString -> Bool -> ExceptT AgentErrorType IO ()
toggleConnectionNtfs AgentClient
a ByteString
connId (ChatSettings -> Bool
chatHasNtfs ChatSettings
chatSettings)
      User -> CM ChatResponse
ok User
user
    ChatType
CTGroup | Maybe GroupChatScope -> Bool
forall a. Maybe a -> Bool
isNothing Maybe GroupChatScope
scope -> do
      [GroupMember]
ms <- (Connection -> ExceptT StoreError IO [GroupMember])
-> CM [GroupMember]
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO [GroupMember])
 -> CM [GroupMember])
-> (Connection -> ExceptT StoreError IO [GroupMember])
-> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
chatId
        [GroupMember]
ms <- IO [GroupMember] -> ExceptT StoreError IO [GroupMember]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GroupMember] -> ExceptT StoreError IO [GroupMember])
-> IO [GroupMember] -> ExceptT StoreError IO [GroupMember]
forall a b. (a -> b) -> a -> b
$ Connection -> GroupInfo -> IO [GroupMember]
getMembers Connection
db GroupInfo
gInfo
        IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings Connection
db User
user Int64
chatId ChatSettings
chatSettings
        [GroupMember] -> ExceptT StoreError IO [GroupMember]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [GroupMember]
ms
      [GroupMember]
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberActive [GroupMember]
ms) ((GroupMember -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \GroupMember
m -> Maybe ByteString
-> (ByteString -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (GroupMember -> Maybe ByteString
memberConnId GroupMember
m) ((ByteString -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ByteString -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \ByteString
connId ->
        (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient -> ByteString -> Bool -> ExceptT AgentErrorType IO ()
toggleConnectionNtfs AgentClient
a ByteString
connId (Bool -> ExceptT AgentErrorType IO ())
-> Bool -> ExceptT AgentErrorType IO ()
forall a b. (a -> b) -> a -> b
$ ChatSettings -> Bool
chatHasNtfs ChatSettings
chatSettings) ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      User -> CM ChatResponse
ok User
user
      where
        getMembers :: Connection -> GroupInfo -> IO [GroupMember]
getMembers Connection
db gInfo :: GroupInfo
gInfo@GroupInfo {BoolDef
useRelays :: GroupInfo -> BoolDef
useRelays :: BoolDef
useRelays}
          | BoolDef -> Bool
isTrue BoolDef
useRelays = Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupRelays Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
          | Bool
otherwise = Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
    ChatType
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  APISetMemberSettings Int64
gId Int64
gMemberId GroupMemberSettings
settings -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    GroupMember
m <- (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User -> Int64 -> Int64 -> GroupMemberSettings -> IO ()
updateGroupMemberSettings Connection
db User
user Int64
gId Int64
gMemberId GroupMemberSettings
settings
      Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    let ntfOn :: Bool
ntfOn = Bool -> Bool
not (GroupMember -> Bool
memberBlocked GroupMember
m)
    GroupMember
-> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
toggleNtf GroupMember
m Bool
ntfOn
    User -> CM ChatResponse
ok User
user
  APIContactInfo Int64
contactId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    -- [incognito] print user's incognito profile for this contact
    ct :: Contact
ct@Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    Maybe LocalProfile
incognitoProfile <- case Maybe Connection
activeConn of
      Maybe Connection
Nothing -> Maybe LocalProfile
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LocalProfile
forall a. Maybe a
Nothing
      Just Connection {Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId :: Connection -> Maybe Int64
customUserProfileId} ->
        Maybe Int64
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int64
customUserProfileId ((Int64
  -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe LocalProfile))
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall a b. (a -> b) -> a -> b
$ \Int64
profileId -> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection -> Int64 -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById Connection
db Int64
userId Int64
profileId)
    Maybe ConnectionStats
connectionStats <- (ByteString
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> Maybe ByteString
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ConnectionStats)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> (ByteString
    -> AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ByteString
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AgentClient
 -> ByteString -> ExceptT AgentErrorType IO ConnectionStats)
-> ByteString
-> AgentClient
-> ExceptT AgentErrorType IO ConnectionStats
forall a b c. (a -> b -> c) -> b -> a -> c
flip AgentClient
-> ByteString -> ExceptT AgentErrorType IO ConnectionStats
getConnectionServers) (Contact -> Maybe ByteString
contactConnId Contact
ct)
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> Contact
-> Maybe ConnectionStats
-> Maybe Profile
-> ChatResponse
CRContactInfo User
user Contact
ct Maybe ConnectionStats
connectionStats ((LocalProfile -> Profile) -> Maybe LocalProfile -> Maybe Profile
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalProfile -> Profile
fromLocalProfile Maybe LocalProfile
incognitoProfile)
  APIContactQueueInfo Int64
contactId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Maybe Connection
activeConn of
      Just Connection
conn -> User -> Connection -> CM ChatResponse
getConnQueueInfo User
user Connection
conn
      Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APIGroupInfo Int64
gId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> GroupInfo -> ChatResponse
CRGroupInfo User
user (GroupInfo -> ChatResponse) -> CM GroupInfo -> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId)
  APIGroupMemberInfo Int64
gId Int64
gMemberId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
g, GroupMember
m) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    Maybe ConnectionStats
connectionStats <- (ByteString
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> Maybe ByteString
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ConnectionStats)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> (ByteString
    -> AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ByteString
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AgentClient
 -> ByteString -> ExceptT AgentErrorType IO ConnectionStats)
-> ByteString
-> AgentClient
-> ExceptT AgentErrorType IO ConnectionStats
forall a b c. (a -> b -> c) -> b -> a -> c
flip AgentClient
-> ByteString -> ExceptT AgentErrorType IO ConnectionStats
getConnectionServers) (GroupMember -> Maybe ByteString
memberConnId GroupMember
m)
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> GroupMember
-> Maybe ConnectionStats
-> ChatResponse
CRGroupMemberInfo User
user GroupInfo
g GroupMember
m Maybe ConnectionStats
connectionStats
  APIGroupMemberQueueInfo Int64
gId Int64
gMemberId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    GroupMember {Maybe Connection
activeConn :: Maybe Connection
activeConn :: GroupMember -> Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    case Maybe Connection
activeConn of
      Just Connection
conn -> User -> Connection -> CM ChatResponse
getConnQueueInfo User
user Connection
conn
      Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APISwitchContact Int64
contactId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Contact -> Maybe ByteString
contactConnId Contact
ct of
      Just ByteString
connId -> do
        ConnectionStats
connectionStats <- (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> ByteString
-> ByteString
-> ExceptT AgentErrorType IO ConnectionStats
switchConnectionAsync AgentClient
a ByteString
"" ByteString
connId
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ConnectionStats -> ChatResponse
CRContactSwitchStarted User
user Contact
ct ConnectionStats
connectionStats
      Maybe ByteString
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APISwitchGroupMember Int64
gId Int64
gMemberId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
g, GroupMember
m) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    case GroupMember -> Maybe ByteString
memberConnId GroupMember
m of
      Just ByteString
connId -> do
        ConnectionStats
connectionStats <- (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> ByteString
-> ByteString
-> ExceptT AgentErrorType IO ConnectionStats
switchConnectionAsync AgentClient
a ByteString
"" ByteString
connId)
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ConnectionStats -> ChatResponse
CRGroupMemberSwitchStarted User
user GroupInfo
g GroupMember
m ConnectionStats
connectionStats
      Maybe ByteString
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APIAbortSwitchContact Int64
contactId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Contact -> Maybe ByteString
contactConnId Contact
ct of
      Just ByteString
connId -> do
        ConnectionStats
connectionStats <- (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> ByteString -> ExceptT AgentErrorType IO ConnectionStats
abortConnectionSwitch AgentClient
a ByteString
connId
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ConnectionStats -> ChatResponse
CRContactSwitchAborted User
user Contact
ct ConnectionStats
connectionStats
      Maybe ByteString
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APIAbortSwitchGroupMember Int64
gId Int64
gMemberId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
g, GroupMember
m) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    case GroupMember -> Maybe ByteString
memberConnId GroupMember
m of
      Just ByteString
connId -> do
        ConnectionStats
connectionStats <- (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> ByteString -> ExceptT AgentErrorType IO ConnectionStats
abortConnectionSwitch AgentClient
a ByteString
connId
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ConnectionStats -> ChatResponse
CRGroupMemberSwitchAborted User
user GroupInfo
g GroupMember
m ConnectionStats
connectionStats
      Maybe ByteString
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APISyncContactRatchet Int64
contactId Bool
force -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"syncContactRatchet" Int64
contactId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Contact -> Maybe Connection
contactConn Contact
ct of
      Just conn :: Connection
conn@Connection {PQSupport
pqSupport :: PQSupport
pqSupport :: Connection -> PQSupport
pqSupport} -> do
        cStats :: ConnectionStats
cStats@ConnectionStats {ratchetSyncState :: ConnectionStats -> RatchetSyncState
ratchetSyncState = RatchetSyncState
rss} <- (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> ByteString
-> PQSupport
-> Bool
-> ExceptT AgentErrorType IO ConnectionStats
synchronizeRatchet AgentClient
a (Connection -> ByteString
aConnId Connection
conn) PQSupport
pqSupport Bool
force
        User
-> ChatDirection 'CTDirect 'MDSnd
-> CIContent 'MDSnd
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) (SndConnEvent -> CIContent 'MDSnd
CISndConnEvent (SndConnEvent -> CIContent 'MDSnd)
-> SndConnEvent -> CIContent 'MDSnd
forall a b. (a -> b) -> a -> b
$ RatchetSyncState -> Maybe GroupMemberRef -> SndConnEvent
SCERatchetSync RatchetSyncState
rss Maybe GroupMemberRef
forall a. Maybe a
Nothing) Maybe UTCTime
forall a. Maybe a
Nothing
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ConnectionStats -> ChatResponse
CRContactRatchetSyncStarted User
user Contact
ct ConnectionStats
cStats
      Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APISyncGroupMemberRatchet Int64
gId Int64
gMemberId Bool
force -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"syncGroupMemberRatchet" Int64
gId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    (GroupInfo
g, GroupMember
m) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    case GroupMember -> Maybe ByteString
memberConnId GroupMember
m of
      Just ByteString
connId -> do
        cStats :: ConnectionStats
cStats@ConnectionStats {ratchetSyncState :: ConnectionStats -> RatchetSyncState
ratchetSyncState = RatchetSyncState
rss} <- (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
 -> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats)
-> (AgentClient -> ExceptT AgentErrorType IO ConnectionStats)
-> ExceptT ChatError (ReaderT ChatController IO) ConnectionStats
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> ByteString
-> PQSupport
-> Bool
-> ExceptT AgentErrorType IO ConnectionStats
synchronizeRatchet AgentClient
a ByteString
connId PQSupport
PQSupportOff Bool
force
        (GroupInfo
g', GroupMember
m', Maybe GroupChatScopeInfo
scopeInfo) <- GroupInfo
-> GroupMember
-> CM (GroupInfo, GroupMember, Maybe GroupChatScopeInfo)
mkGroupChatScope GroupInfo
g GroupMember
m
        User
-> ChatDirection 'CTGroup 'MDSnd
-> CIContent 'MDSnd
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
g' Maybe GroupChatScopeInfo
scopeInfo) (SndConnEvent -> CIContent 'MDSnd
CISndConnEvent (SndConnEvent -> CIContent 'MDSnd)
-> (GroupMemberRef -> SndConnEvent)
-> GroupMemberRef
-> CIContent 'MDSnd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RatchetSyncState -> Maybe GroupMemberRef -> SndConnEvent
SCERatchetSync RatchetSyncState
rss (Maybe GroupMemberRef -> SndConnEvent)
-> (GroupMemberRef -> Maybe GroupMemberRef)
-> GroupMemberRef
-> SndConnEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupMemberRef -> Maybe GroupMemberRef
forall a. a -> Maybe a
Just (GroupMemberRef -> CIContent 'MDSnd)
-> GroupMemberRef -> CIContent 'MDSnd
forall a b. (a -> b) -> a -> b
$ GroupMember -> GroupMemberRef
groupMemberRef GroupMember
m') Maybe UTCTime
forall a. Maybe a
Nothing
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ConnectionStats -> ChatResponse
CRGroupMemberRatchetSyncStarted User
user GroupInfo
g' GroupMember
m' ConnectionStats
cStats
      Maybe ByteString
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APIGetContactCode Int64
contactId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Maybe Connection
activeConn of
      Just conn :: Connection
conn@Connection {Int64
connId :: Int64
connId :: Connection -> Int64
connId} -> do
        Text
code <- ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
getConnectionCode (ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text)
-> ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
aConnId Connection
conn
        Contact
ct' <- case Contact -> Maybe SecurityCode
contactSecurityCode Contact
ct of
          Just SecurityCode {Text
securityCode :: Text
securityCode :: SecurityCode -> Text
securityCode}
            | Text -> Text -> Bool
sameVerificationCode Text
code Text
securityCode -> Contact -> CM Contact
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
ct
            | Bool
otherwise -> do
                (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Maybe Text -> IO ()
setConnectionVerified Connection
db User
user Int64
connId Maybe Text
forall a. Maybe a
Nothing
                Contact -> CM Contact
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contact
ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}}
          Maybe SecurityCode
_ -> Contact -> CM Contact
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
ct
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Text -> ChatResponse
CRContactCode User
user Contact
ct' Text
code
      Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APIGetGroupMemberCode Int64
gId Int64
gMemberId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
g, m :: GroupMember
m@GroupMember {Maybe Connection
activeConn :: GroupMember -> Maybe Connection
activeConn :: Maybe Connection
activeConn}) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    case Maybe Connection
activeConn of
      Just conn :: Connection
conn@Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} -> do
        Text
code <- ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
getConnectionCode (ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text)
-> ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
aConnId Connection
conn
        GroupMember
m' <- case GroupMember -> Maybe SecurityCode
memberSecurityCode GroupMember
m of
          Just SecurityCode {Text
securityCode :: SecurityCode -> Text
securityCode :: Text
securityCode}
            | Text -> Text -> Bool
sameVerificationCode Text
code Text
securityCode -> GroupMember -> CM GroupMember
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m
            | Bool
otherwise -> do
                (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Maybe Text -> IO ()
setConnectionVerified Connection
db User
user Int64
connId Maybe Text
forall a. Maybe a
Nothing
                GroupMember -> CM GroupMember
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember
m :: GroupMember) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}}
          Maybe SecurityCode
_ -> GroupMember -> CM GroupMember
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> Text -> ChatResponse
CRGroupMemberCode User
user GroupInfo
g GroupMember
m' Text
code
      Maybe Connection
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APIVerifyContact Int64
contactId Maybe Text
code -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Maybe Connection
activeConn of
      Just Connection
conn -> User -> Connection -> Maybe Text -> CM ChatResponse
verifyConnectionCode User
user Connection
conn Maybe Text
code
      Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APIVerifyGroupMember Int64
gId Int64
gMemberId Maybe Text
code -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    GroupMember {Maybe Connection
activeConn :: GroupMember -> Maybe Connection
activeConn :: Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    case Maybe Connection
activeConn of
      Just Connection
conn -> User -> Connection -> Maybe Text -> CM ChatResponse
verifyConnectionCode User
user Connection
conn Maybe Text
code
      Maybe Connection
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APIEnableContact Int64
contactId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Maybe Connection
activeConn of
      Just Connection
conn -> do
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Connection -> Int -> IO ()
setAuthErrCounter Connection
db User
user Connection
conn Int
0
        User -> CM ChatResponse
ok User
user
      Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APIEnableGroupMember Int64
gId Int64
gMemberId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    GroupMember {Maybe Connection
activeConn :: GroupMember -> Maybe Connection
activeConn :: Maybe Connection
activeConn} <- (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    case Maybe Connection
activeConn of
      Just Connection
conn -> do
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Connection -> Int -> IO ()
setAuthErrCounter Connection
db User
user Connection
conn Int
0
        User -> CM ChatResponse
ok User
user
      Maybe Connection
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  SetShowMessages ChatName
cName MsgFilter
ntfOn -> ChatName -> (ChatSettings -> ChatSettings) -> CM ChatResponse
updateChatSettings ChatName
cName (\ChatSettings
cs -> ChatSettings
cs {enableNtfs = ntfOn})
  SetSendReceipts ChatName
cName Maybe Bool
rcptsOn_ -> ChatName -> (ChatSettings -> ChatSettings) -> CM ChatResponse
updateChatSettings ChatName
cName (\ChatSettings
cs -> ChatSettings
cs {sendRcpts = rcptsOn_})
  SetShowMemberMessages Text
gName Text
mName Bool
showMessages -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Int64
gId, Int64
mId) <- User -> Text -> Text -> CM (Int64, Int64)
getGroupAndMemberId User
user Text
gName Text
mName
    GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId
    GroupMember
m <- (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
mId
    let GroupInfo {membership :: GroupInfo -> GroupMember
membership = GroupMember {memberRole :: GroupMember -> GroupMemberRole
memberRole = GroupMemberRole
membershipRole}} = GroupInfo
gInfo
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMemberRole
membershipRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
>= GroupMemberRole
GRModerator) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMember -> Bool -> ChatErrorType
CECantBlockMemberForSelf GroupInfo
gInfo GroupMember
m Bool
showMessages
    let settings :: GroupMemberSettings
settings = (GroupMember -> GroupMemberSettings
memberSettings GroupMember
m) {showMessages}
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> GroupMemberSettings -> ChatCommand
APISetMemberSettings Int64
gId Int64
mId GroupMemberSettings
settings
  ContactInfo Text
cName -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName Int64 -> ChatCommand
APIContactInfo
  ShowGroupInfo Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIGroupInfo Int64
groupId
  GroupMemberInfo Text
gName Text
mName -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName Int64 -> Int64 -> ChatCommand
APIGroupMemberInfo
  ContactQueueInfo Text
cName -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName Int64 -> ChatCommand
APIContactQueueInfo
  GroupMemberQueueInfo Text
gName Text
mName -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName Int64 -> Int64 -> ChatCommand
APIGroupMemberQueueInfo
  SwitchContact Text
cName -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName Int64 -> ChatCommand
APISwitchContact
  SwitchGroupMember Text
gName Text
mName -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName Int64 -> Int64 -> ChatCommand
APISwitchGroupMember
  AbortSwitchContact Text
cName -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName Int64 -> ChatCommand
APIAbortSwitchContact
  AbortSwitchGroupMember Text
gName Text
mName -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName Int64 -> Int64 -> ChatCommand
APIAbortSwitchGroupMember
  SyncContactRatchet Text
cName Bool
force -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName ((Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
ctId -> Int64 -> Bool -> ChatCommand
APISyncContactRatchet Int64
ctId Bool
force
  SyncGroupMemberRatchet Text
gName Text
mName Bool
force -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName ((Int64 -> Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
gId Int64
mId -> Int64 -> Int64 -> Bool -> ChatCommand
APISyncGroupMemberRatchet Int64
gId Int64
mId Bool
force
  GetContactCode Text
cName -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName Int64 -> ChatCommand
APIGetContactCode
  GetGroupMemberCode Text
gName Text
mName -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName Int64 -> Int64 -> ChatCommand
APIGetGroupMemberCode
  VerifyContact Text
cName Maybe Text
code -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName (Int64 -> Maybe Text -> ChatCommand
`APIVerifyContact` Maybe Text
code)
  VerifyGroupMember Text
gName Text
mName Maybe Text
code -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName ((Int64 -> Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
gId Int64
mId -> Int64 -> Int64 -> Maybe Text -> ChatCommand
APIVerifyGroupMember Int64
gId Int64
mId Maybe Text
code
  EnableContact Text
cName -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName Int64 -> ChatCommand
APIEnableContact
  EnableGroupMember Text
gName Text
mName -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName ((Int64 -> Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
gId Int64
mId -> Int64 -> Int64 -> ChatCommand
APIEnableGroupMember Int64
gId Int64
mId
  ChatHelp HelpSection
section -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ HelpSection -> ChatResponse
CRChatHelp HelpSection
section
  ChatCommand
Welcome -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> (User -> ChatResponse) -> User -> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> ChatResponse
CRWelcome
  APIAddContact Int64
userId Bool
incognito -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    -- [incognito] generate profile for connection
    Maybe Profile
incognitoProfile <- if Bool
incognito then Profile -> Maybe Profile
forall a. a -> Maybe a
Just (Profile -> Maybe Profile)
-> ExceptT ChatError (ReaderT ChatController IO) Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Profile -> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Profile
generateRandomProfile else Maybe Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Profile
forall a. Maybe a
Nothing
    SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
    let userData :: UserLinkData
userData = Profile -> Maybe AddressSettings -> UserLinkData
contactShortLinkData (User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user Maybe Profile
incognitoProfile Maybe Contact
forall a. Maybe a
Nothing Bool
True) Maybe AddressSettings
forall a. Maybe a
Nothing
        userLinkData :: UserConnLinkData 'CMInvitation
userLinkData = UserLinkData -> UserConnLinkData 'CMInvitation
UserInvLinkData UserLinkData
userData
    -- TODO [certs rcv]
    (ByteString
connId, (CreatedConnLink 'CMInvitation
ccLink, Maybe (DBEntityId' 'DBStored)
_serviceId)) <- (AgentClient
 -> ExceptT
      AgentErrorType
      IO
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT
       AgentErrorType
       IO
       (ByteString,
        (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
 -> CM
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> (AgentClient
    -> ExceptT
         AgentErrorType
         IO
         (ByteString,
          (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode 'CMInvitation
-> Maybe (UserConnLinkData 'CMInvitation)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> ExceptT
     AgentErrorType
     IO
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall (c :: ConnectionMode).
ConnectionModeI c =>
AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode c
-> Maybe (UserConnLinkData c)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> AE
     (ByteString, (CreatedConnLink c, Maybe (DBEntityId' 'DBStored)))
createConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) Bool
True Bool
False SConnectionMode 'CMInvitation
SCMInvitation (UserConnLinkData 'CMInvitation
-> Maybe (UserConnLinkData 'CMInvitation)
forall a. a -> Maybe a
Just UserConnLinkData 'CMInvitation
userLinkData) Maybe Text
forall a. Maybe a
Nothing InitialKeys
IKPQOn SubscriptionMode
subMode
    CreatedConnLink 'CMInvitation
ccLink' <- CreatedConnLink 'CMInvitation -> CM (CreatedConnLink 'CMInvitation)
forall (m :: ConnectionMode).
CreatedConnLink m -> CM (CreatedConnLink m)
shortenCreatedLink CreatedConnLink 'CMInvitation
ccLink
    -- TODO PQ pass minVersion from the current range
    PendingContactConnection
conn <- (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> ByteString
-> CreatedConnLink 'CMInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> Version ChatVersion
-> PQSupport
-> IO PendingContactConnection
createDirectConnection Connection
db User
user ByteString
connId CreatedConnLink 'CMInvitation
ccLink' Maybe Int64
forall a. Maybe a
Nothing ConnStatus
ConnNew Maybe Profile
incognitoProfile SubscriptionMode
subMode Version ChatVersion
initialChatVersion PQSupport
PQSupportOn
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> CreatedConnLink 'CMInvitation
-> PendingContactConnection
-> ChatResponse
CRInvitation User
user CreatedConnLink 'CMInvitation
ccLink' PendingContactConnection
conn
  AddContact Bool
incognito -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> ChatCommand
APIAddContact Int64
userId Bool
incognito
  APISetConnectionIncognito Int64
connId Bool
incognito -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    PendingContactConnection
conn <- (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64 -> Int64 -> ExceptT StoreError IO PendingContactConnection
getPendingContactConnection Connection
db Int64
userId Int64
connId
    let PendingContactConnection {ConnStatus
pccConnStatus :: ConnStatus
pccConnStatus :: PendingContactConnection -> ConnStatus
pccConnStatus, Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId :: PendingContactConnection -> Maybe Int64
customUserProfileId} = PendingContactConnection
conn
    case (ConnStatus
pccConnStatus, Maybe Int64
customUserProfileId, Bool
incognito) of
      (ConnStatus
ConnNew, Maybe Int64
Nothing, Bool
True) -> do
        Profile
incognitoProfile <- IO Profile -> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Profile
generateRandomProfile
        Maybe ShortLinkInvitation
sLnk <- PendingContactConnection
-> Profile -> CM (Maybe ShortLinkInvitation)
updatePCCShortLinkData PendingContactConnection
conn (Profile -> CM (Maybe ShortLinkInvitation))
-> Profile -> CM (Maybe ShortLinkInvitation)
forall a b. (a -> b) -> a -> b
$ User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user (Profile -> Maybe Profile
forall a. a -> Maybe a
Just Profile
incognitoProfile) Maybe Contact
forall a. Maybe a
Nothing Bool
True
        PendingContactConnection
conn' <- (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          Int64
pId <- Connection -> User -> Profile -> IO Int64
createIncognitoProfile Connection
db User
user Profile
incognitoProfile
          Connection
-> User
-> PendingContactConnection
-> Maybe Int64
-> Maybe ShortLinkInvitation
-> IO PendingContactConnection
updatePCCIncognito Connection
db User
user PendingContactConnection
conn (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
pId) Maybe ShortLinkInvitation
sLnk
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> PendingContactConnection -> Maybe Profile -> ChatResponse
CRConnectionIncognitoUpdated User
user PendingContactConnection
conn' (Profile -> Maybe Profile
forall a. a -> Maybe a
Just Profile
incognitoProfile)
      (ConnStatus
ConnNew, Just Int64
pId, Bool
False) -> do
        Maybe ShortLinkInvitation
sLnk <- PendingContactConnection
-> Profile -> CM (Maybe ShortLinkInvitation)
updatePCCShortLinkData PendingContactConnection
conn (Profile -> CM (Maybe ShortLinkInvitation))
-> Profile -> CM (Maybe ShortLinkInvitation)
forall a b. (a -> b) -> a -> b
$ User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user Maybe Profile
forall a. Maybe a
Nothing Maybe Contact
forall a. Maybe a
Nothing Bool
True
        PendingContactConnection
conn' <- (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          Connection -> User -> Int64 -> IO ()
deletePCCIncognitoProfile Connection
db User
user Int64
pId
          Connection
-> User
-> PendingContactConnection
-> Maybe Int64
-> Maybe ShortLinkInvitation
-> IO PendingContactConnection
updatePCCIncognito Connection
db User
user PendingContactConnection
conn Maybe Int64
forall a. Maybe a
Nothing Maybe ShortLinkInvitation
sLnk
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> PendingContactConnection -> Maybe Profile -> ChatResponse
CRConnectionIncognitoUpdated User
user PendingContactConnection
conn' Maybe Profile
forall a. Maybe a
Nothing
      (ConnStatus, Maybe Int64, Bool)
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEConnectionIncognitoChangeProhibited
  APIChangeConnectionUser Int64
connId Int64
newUserId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    PendingContactConnection
conn <- (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> ExceptT StoreError IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64 -> Int64 -> ExceptT StoreError IO PendingContactConnection
getPendingContactConnection Connection
db Int64
userId Int64
connId
    let PendingContactConnection {ConnStatus
pccConnStatus :: PendingContactConnection -> ConnStatus
pccConnStatus :: ConnStatus
pccConnStatus, Maybe (CreatedConnLink 'CMInvitation)
connLinkInv :: Maybe (CreatedConnLink 'CMInvitation)
connLinkInv :: PendingContactConnection -> Maybe (CreatedConnLink 'CMInvitation)
connLinkInv} = PendingContactConnection
conn
    case (ConnStatus
pccConnStatus, Maybe (CreatedConnLink 'CMInvitation)
connLinkInv) of
      (ConnStatus
ConnNew, Just CreatedConnLink 'CMInvitation
_ссLink) -> do
        User
newUser <- Int64 -> CM User
privateGetUser Int64
newUserId
        PendingContactConnection
conn' <- User
-> PendingContactConnection -> User -> CM PendingContactConnection
recreateConn User
user PendingContactConnection
conn User
newUser
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> PendingContactConnection
-> PendingContactConnection
-> User
-> ChatResponse
CRConnectionUserChanged User
user PendingContactConnection
conn PendingContactConnection
conn' User
newUser
      (ConnStatus, Maybe (CreatedConnLink 'CMInvitation))
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEConnectionUserChangeProhibited
    where
      recreateConn :: User
-> PendingContactConnection -> User -> CM PendingContactConnection
recreateConn User
user conn :: PendingContactConnection
conn@PendingContactConnection {Maybe Int64
customUserProfileId :: PendingContactConnection -> Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId, Maybe (CreatedConnLink 'CMInvitation)
connLinkInv :: PendingContactConnection -> Maybe (CreatedConnLink 'CMInvitation)
connLinkInv :: Maybe (CreatedConnLink 'CMInvitation)
connLinkInv} User
newUser = do
        SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
        let short :: Bool
short = Maybe ShortLinkInvitation -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ShortLinkInvitation -> Bool)
-> Maybe ShortLinkInvitation -> Bool
forall a b. (a -> b) -> a -> b
$ CreatedConnLink 'CMInvitation -> Maybe ShortLinkInvitation
forall (m :: ConnectionMode).
CreatedConnLink m -> Maybe (ConnShortLink m)
connShortLink (CreatedConnLink 'CMInvitation -> Maybe ShortLinkInvitation)
-> Maybe (CreatedConnLink 'CMInvitation)
-> Maybe ShortLinkInvitation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (CreatedConnLink 'CMInvitation)
connLinkInv
            userLinkData_ :: Maybe (UserConnLinkData 'CMInvitation)
userLinkData_
              | Bool
short = UserConnLinkData 'CMInvitation
-> Maybe (UserConnLinkData 'CMInvitation)
forall a. a -> Maybe a
Just (UserConnLinkData 'CMInvitation
 -> Maybe (UserConnLinkData 'CMInvitation))
-> UserConnLinkData 'CMInvitation
-> Maybe (UserConnLinkData 'CMInvitation)
forall a b. (a -> b) -> a -> b
$ UserLinkData -> UserConnLinkData 'CMInvitation
UserInvLinkData (UserLinkData -> UserConnLinkData 'CMInvitation)
-> UserLinkData -> UserConnLinkData 'CMInvitation
forall a b. (a -> b) -> a -> b
$ Profile -> Maybe AddressSettings -> UserLinkData
contactShortLinkData (User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
newUser Maybe Profile
forall a. Maybe a
Nothing Maybe Contact
forall a. Maybe a
Nothing Bool
True) Maybe AddressSettings
forall a. Maybe a
Nothing
              | Bool
otherwise = Maybe (UserConnLinkData 'CMInvitation)
forall a. Maybe a
Nothing
        -- TODO [certs rcv]
        (ByteString
agConnId, (CreatedConnLink 'CMInvitation
ccLink, Maybe (DBEntityId' 'DBStored)
_serviceId)) <- (AgentClient
 -> ExceptT
      AgentErrorType
      IO
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT
       AgentErrorType
       IO
       (ByteString,
        (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
 -> CM
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> (AgentClient
    -> ExceptT
         AgentErrorType
         IO
         (ByteString,
          (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode 'CMInvitation
-> Maybe (UserConnLinkData 'CMInvitation)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> ExceptT
     AgentErrorType
     IO
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall (c :: ConnectionMode).
ConnectionModeI c =>
AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode c
-> Maybe (UserConnLinkData c)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> AE
     (ByteString, (CreatedConnLink c, Maybe (DBEntityId' 'DBStored)))
createConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
newUser) Bool
True Bool
False SConnectionMode 'CMInvitation
SCMInvitation Maybe (UserConnLinkData 'CMInvitation)
userLinkData_ Maybe Text
forall a. Maybe a
Nothing InitialKeys
IKPQOn SubscriptionMode
subMode
        CreatedConnLink 'CMInvitation
ccLink' <- CreatedConnLink 'CMInvitation -> CM (CreatedConnLink 'CMInvitation)
forall (m :: ConnectionMode).
CreatedConnLink m -> CM (CreatedConnLink m)
shortenCreatedLink CreatedConnLink 'CMInvitation
ccLink
        PendingContactConnection
conn' <- (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO PendingContactConnection)
 -> CM PendingContactConnection)
-> (Connection -> IO PendingContactConnection)
-> CM PendingContactConnection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          Connection -> User -> Int64 -> IO ()
deleteConnectionRecord Connection
db User
user Int64
connId
          Maybe Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int64
customUserProfileId ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
profileId ->
            Connection -> User -> Int64 -> IO ()
deletePCCIncognitoProfile Connection
db User
user Int64
profileId
          Connection
-> User
-> ByteString
-> CreatedConnLink 'CMInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> Version ChatVersion
-> PQSupport
-> IO PendingContactConnection
createDirectConnection Connection
db User
newUser ByteString
agConnId CreatedConnLink 'CMInvitation
ccLink' Maybe Int64
forall a. Maybe a
Nothing ConnStatus
ConnNew Maybe Profile
forall a. Maybe a
Nothing SubscriptionMode
subMode Version ChatVersion
initialChatVersion PQSupport
PQSupportOn
        ByteString -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteAgentConnectionAsync (PendingContactConnection -> ByteString
aConnId' PendingContactConnection
conn)
        PendingContactConnection -> CM PendingContactConnection
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PendingContactConnection
conn'
  APIConnectPlan Int64
userId (Just AConnectionLink
cLink) -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    (ACreatedConnLink -> ConnectionPlan -> ChatResponse)
-> (ACreatedConnLink, ConnectionPlan) -> ChatResponse
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (User -> ACreatedConnLink -> ConnectionPlan -> ChatResponse
CRConnectionPlan User
user) ((ACreatedConnLink, ConnectionPlan) -> ChatResponse)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User
-> AConnectionLink
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
connectPlan User
user AConnectionLink
cLink
  APIConnectPlan Int64
_ Maybe AConnectionLink
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidConnReq
  APIPrepareContact Int64
userId ACreatedConnLink
accLink ContactShortLinkData
contactSLinkData -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    let ContactShortLinkData {Profile
profile :: Profile
profile :: ContactShortLinkData -> Profile
profile, Maybe MsgContent
message :: Maybe MsgContent
message :: ContactShortLinkData -> Maybe MsgContent
message, Bool
business :: Bool
business :: ContactShortLinkData -> Bool
business} = ContactShortLinkData
contactSLinkData
    Maybe SharedMsgId
welcomeSharedMsgId <- Maybe MsgContent
-> (MsgContent
    -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe SharedMsgId)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe MsgContent
message ((MsgContent
  -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe SharedMsgId))
-> (MsgContent
    -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe SharedMsgId)
forall a b. (a -> b) -> a -> b
$ \MsgContent
_ -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId
getSharedMsgId
    case ACreatedConnLink
accLink of
      ACCL SConnectionMode m
SCMContact CreatedConnLink m
ccLink
        | Bool
business -> do
            let Profile {Maybe Preferences
preferences :: Maybe Preferences
preferences :: Profile -> Maybe Preferences
preferences} = Profile
profile
                groupPreferences :: GroupPreferences
groupPreferences = GroupPreferences
-> (Preferences -> GroupPreferences)
-> Maybe Preferences
-> GroupPreferences
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GroupPreferences
defaultBusinessGroupPrefs Preferences -> GroupPreferences
businessGroupPrefs Maybe Preferences
preferences
                groupProfile :: GroupProfile
groupProfile = Profile -> GroupPreferences -> GroupProfile
businessGroupProfile Profile
profile GroupPreferences
groupPreferences
            (GroupInfo
gInfo, GroupMember
hostMember) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> GroupProfile
-> Bool
-> CreatedLinkContact
-> Maybe SharedMsgId
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createPreparedGroup Connection
db VersionRangeChat
vr User
user GroupProfile
groupProfile Bool
True CreatedConnLink m
CreatedLinkContact
ccLink Maybe SharedMsgId
welcomeSharedMsgId
            ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ChatError (ReaderT ChatController IO) AChatItem
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> ChatDirection 'CTGroup 'MDSnd
-> Bool
-> CIContent 'MDSnd
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing) Bool
False CIContent 'MDSnd
CIChatBanner Maybe SharedMsgId
forall a. Maybe a
Nothing (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
epochStart)
            let cd :: ChatDirection 'CTGroup 'MDRcv
cd = GroupInfo
-> Maybe GroupChatScopeInfo
-> GroupMember
-> ChatDirection 'CTGroup 'MDRcv
CDGroupRcv GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing GroupMember
hostMember
                createItem :: Maybe SharedMsgId
-> CIContent 'MDRcv
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createItem Maybe SharedMsgId
sharedMsgId CIContent 'MDRcv
content = User
-> ChatDirection 'CTGroup 'MDRcv
-> Bool
-> CIContent 'MDRcv
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user ChatDirection 'CTGroup 'MDRcv
cd Bool
True CIContent 'MDRcv
content Maybe SharedMsgId
sharedMsgId Maybe UTCTime
forall a. Maybe a
Nothing
                cInfo :: ChatInfo 'CTGroup
cInfo = GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing
            CM [AChatItem] -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM [AChatItem]
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM [AChatItem]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> ChatDirection 'CTGroup 'MDRcv
-> Bool
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent 'MDRcv)
-> GroupInfo
-> CM [AChatItem]
forall (d :: MsgDirection).
MsgDirectionI d =>
User
-> ChatDirection 'CTGroup d
-> Bool
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent d)
-> GroupInfo
-> CM [AChatItem]
createGroupFeatureItems_ User
user ChatDirection 'CTGroup 'MDRcv
cd Bool
True GroupFeature
-> GroupPreference
-> Maybe Int
-> Maybe GroupMemberRole
-> CIContent 'MDRcv
CIRcvGroupFeature GroupInfo
gInfo
            Maybe AChatItem
aci <- (MsgContent
 -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> Maybe MsgContent -> CM (Maybe AChatItem)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Maybe SharedMsgId
-> CIContent 'MDRcv
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createItem Maybe SharedMsgId
welcomeSharedMsgId (CIContent 'MDRcv
 -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> (MsgContent -> CIContent 'MDRcv)
-> MsgContent
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgContent -> CIContent 'MDRcv
CIRcvMsgContent) Maybe MsgContent
message
            let chat :: Chat 'CTGroup
chat = case Maybe AChatItem
aci of
                  Just (AChatItem SChatType c
SCTGroup SMsgDirection d
dir ChatInfo c
_ ChatItem c d
ci) -> ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat ChatInfo 'CTGroup
cInfo [SMsgDirection d -> ChatItem c d -> CChatItem c
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
dir ChatItem c d
ci] ChatStats
emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
                  Maybe AChatItem
_ -> ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat ChatInfo 'CTGroup
cInfo [] ChatStats
emptyChatStats
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChat -> ChatResponse
CRNewPreparedChat User
user (AChat -> ChatResponse) -> AChat -> ChatResponse
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup -> Chat 'CTGroup -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTGroup
SCTGroup Chat 'CTGroup
chat
      ACCL SConnectionMode m
_ (CCLink ConnectionRequestUri m
cReq Maybe (ConnShortLink m)
_) -> do
        Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Profile
-> ACreatedConnLink
-> Maybe SharedMsgId
-> ExceptT StoreError IO Contact
createPreparedContact Connection
db VersionRangeChat
vr User
user Profile
profile ACreatedConnLink
accLink Maybe SharedMsgId
welcomeSharedMsgId
        ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ChatError (ReaderT ChatController IO) AChatItem
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> ChatDirection 'CTDirect 'MDSnd
-> Bool
-> CIContent 'MDSnd
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) Bool
False CIContent 'MDSnd
CIChatBanner Maybe SharedMsgId
forall a. Maybe a
Nothing (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
epochStart)
        let cd :: ChatDirection 'CTDirect 'MDRcv
cd = Contact -> ChatDirection 'CTDirect 'MDRcv
CDDirectRcv Contact
ct
            createItem :: Maybe SharedMsgId
-> CIContent 'MDRcv
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createItem Maybe SharedMsgId
sharedMsgId CIContent 'MDRcv
content = User
-> ChatDirection 'CTDirect 'MDRcv
-> Bool
-> CIContent 'MDRcv
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user ChatDirection 'CTDirect 'MDRcv
cd Bool
False CIContent 'MDRcv
content Maybe SharedMsgId
sharedMsgId Maybe UTCTime
forall a. Maybe a
Nothing
            cInfo :: ChatInfo 'CTDirect
cInfo = Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct
        ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ChatError (ReaderT ChatController IO) AChatItem
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Maybe SharedMsgId
-> CIContent 'MDRcv
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createItem Maybe SharedMsgId
forall a. Maybe a
Nothing (CIContent 'MDRcv
 -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> CIContent 'MDRcv
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall a b. (a -> b) -> a -> b
$ E2EInfo -> CIContent 'MDRcv
CIRcvDirectE2EEInfo (E2EInfo -> CIContent 'MDRcv) -> E2EInfo -> CIContent 'MDRcv
forall a b. (a -> b) -> a -> b
$ Maybe PQEncryption -> E2EInfo
E2EInfo (Maybe PQEncryption -> E2EInfo) -> Maybe PQEncryption -> E2EInfo
forall a b. (a -> b) -> a -> b
$ ConnectionRequestUri m -> Maybe PQEncryption
forall (c :: ConnectionMode).
ConnectionRequestUri c -> Maybe PQEncryption
connRequestPQEncryption ConnectionRequestUri m
cReq
        CM [AChatItem] -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM [AChatItem]
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM [AChatItem]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Contact -> CM [AChatItem]
createFeatureEnabledItems_ User
user Contact
ct
        Maybe AChatItem
aci <- (MsgContent
 -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> Maybe MsgContent -> CM (Maybe AChatItem)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Maybe SharedMsgId
-> CIContent 'MDRcv
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createItem Maybe SharedMsgId
welcomeSharedMsgId (CIContent 'MDRcv
 -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> (MsgContent -> CIContent 'MDRcv)
-> MsgContent
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MsgContent -> CIContent 'MDRcv
CIRcvMsgContent) Maybe MsgContent
message
        let chat :: Chat 'CTDirect
chat = case Maybe AChatItem
aci of
              Just (AChatItem SChatType c
SCTDirect SMsgDirection d
dir ChatInfo c
_ ChatItem c d
ci) -> ChatInfo 'CTDirect
-> [CChatItem 'CTDirect] -> ChatStats -> Chat 'CTDirect
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat ChatInfo 'CTDirect
cInfo [SMsgDirection d -> ChatItem c d -> CChatItem c
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
dir ChatItem c d
ci] ChatStats
emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
              Maybe AChatItem
_ -> ChatInfo 'CTDirect
-> [CChatItem 'CTDirect] -> ChatStats -> Chat 'CTDirect
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat ChatInfo 'CTDirect
cInfo [] ChatStats
emptyChatStats
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChat -> ChatResponse
CRNewPreparedChat User
user (AChat -> ChatResponse) -> AChat -> ChatResponse
forall a b. (a -> b) -> a -> b
$ SChatType 'CTDirect -> Chat 'CTDirect -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTDirect
SCTDirect Chat 'CTDirect
chat
  APIPrepareGroup Int64
userId CreatedLinkContact
ccLink GroupShortLinkData
groupSLinkData -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    let GroupShortLinkData {groupProfile :: GroupShortLinkData -> GroupProfile
groupProfile = gp :: GroupProfile
gp@GroupProfile {Maybe Text
description :: Maybe Text
description :: GroupProfile -> Maybe Text
description}} = GroupShortLinkData
groupSLinkData
    Maybe SharedMsgId
welcomeSharedMsgId <- Maybe Text
-> (Text
    -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe SharedMsgId)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Text
description ((Text
  -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe SharedMsgId))
-> (Text
    -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe SharedMsgId)
forall a b. (a -> b) -> a -> b
$ \Text
_ -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId
getSharedMsgId
    (GroupInfo
gInfo, GroupMember
hostMember) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> GroupProfile
-> Bool
-> CreatedLinkContact
-> Maybe SharedMsgId
-> ExceptT StoreError IO (GroupInfo, GroupMember)
createPreparedGroup Connection
db VersionRangeChat
vr User
user GroupProfile
gp Bool
False CreatedLinkContact
ccLink Maybe SharedMsgId
welcomeSharedMsgId
    ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ChatError (ReaderT ChatController IO) AChatItem
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> ChatDirection 'CTGroup 'MDSnd
-> Bool
-> CIContent 'MDSnd
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing) Bool
False CIContent 'MDSnd
CIChatBanner Maybe SharedMsgId
forall a. Maybe a
Nothing (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
epochStart)
    let cd :: ChatDirection 'CTGroup 'MDRcv
cd = GroupInfo
-> Maybe GroupChatScopeInfo
-> GroupMember
-> ChatDirection 'CTGroup 'MDRcv
CDGroupRcv GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing GroupMember
hostMember
        cInfo :: ChatInfo 'CTGroup
cInfo = GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing
    CM [AChatItem] -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM [AChatItem]
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM [AChatItem]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> ChatDirection 'CTGroup 'MDRcv
-> Bool
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent 'MDRcv)
-> GroupInfo
-> CM [AChatItem]
forall (d :: MsgDirection).
MsgDirectionI d =>
User
-> ChatDirection 'CTGroup d
-> Bool
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent d)
-> GroupInfo
-> CM [AChatItem]
createGroupFeatureItems_ User
user ChatDirection 'CTGroup 'MDRcv
cd Bool
True GroupFeature
-> GroupPreference
-> Maybe Int
-> Maybe GroupMemberRole
-> CIContent 'MDRcv
CIRcvGroupFeature GroupInfo
gInfo
    Maybe AChatItem
aci <- Maybe Text
-> (Text
    -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> CM (Maybe AChatItem)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Text
description ((Text -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
 -> CM (Maybe AChatItem))
-> (Text
    -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> CM (Maybe AChatItem)
forall a b. (a -> b) -> a -> b
$ \Text
descr -> User
-> ChatDirection 'CTGroup 'MDRcv
-> Bool
-> CIContent 'MDRcv
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user ChatDirection 'CTGroup 'MDRcv
cd Bool
True (MsgContent -> CIContent 'MDRcv
CIRcvMsgContent (MsgContent -> CIContent 'MDRcv) -> MsgContent -> CIContent 'MDRcv
forall a b. (a -> b) -> a -> b
$ Text -> MsgContent
MCText Text
descr) Maybe SharedMsgId
welcomeSharedMsgId Maybe UTCTime
forall a. Maybe a
Nothing
    let chat :: Chat 'CTGroup
chat = case Maybe AChatItem
aci of
          Just (AChatItem SChatType c
SCTGroup SMsgDirection d
dir ChatInfo c
_ ChatItem c d
ci) -> ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat ChatInfo 'CTGroup
cInfo [SMsgDirection d -> ChatItem c d -> CChatItem c
forall (c :: ChatType) (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> ChatItem c d -> CChatItem c
CChatItem SMsgDirection d
dir ChatItem c d
ci] ChatStats
emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
          Maybe AChatItem
_ -> ChatInfo 'CTGroup
-> [CChatItem 'CTGroup] -> ChatStats -> Chat 'CTGroup
forall (c :: ChatType).
ChatInfo c -> [CChatItem c] -> ChatStats -> Chat c
Chat ChatInfo 'CTGroup
cInfo [] ChatStats
emptyChatStats
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChat -> ChatResponse
CRNewPreparedChat User
user (AChat -> ChatResponse) -> AChat -> ChatResponse
forall a b. (a -> b) -> a -> b
$ SChatType 'CTGroup -> Chat 'CTGroup -> AChat
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> Chat c -> AChat
AChat SChatType 'CTGroup
SCTGroup Chat 'CTGroup
chat
  APIChangePreparedContactUser Int64
contactId Int64
newUserId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {Maybe PreparedContact
preparedContact :: Maybe PreparedContact
preparedContact :: Contact -> Maybe PreparedContact
preparedContact} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PreparedContact -> Bool
forall a. Maybe a -> Bool
isNothing Maybe PreparedContact
preparedContact) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"contact doesn't have link to connect"
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Connection -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Connection -> Bool) -> Maybe Connection -> Bool
forall a b. (a -> b) -> a -> b
$ Contact -> Maybe Connection
contactConn Contact
ct) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"contact already has connection"
    User
newUser <- Int64 -> CM User
privateGetUser Int64
newUserId
    Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Contact
-> User
-> ExceptT StoreError IO Contact
updatePreparedContactUser Connection
db VersionRangeChat
vr User
user Contact
ct User
newUser
    -- create changed feature items (new user may have different preferences)
    ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Contact -> ReaderT ChatController IO ()
createContactChangedFeatureItems User
user Contact
ct Contact
ct'
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> User -> Contact -> ChatResponse
CRContactUserChanged User
user Contact
ct User
newUser Contact
ct'
  APIChangePreparedGroupUser Int64
groupId Int64
newUserId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
gInfo, GroupMember
hostMember) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupMember
getHostMember Connection
db VersionRangeChat
vr User
user Int64
groupId
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe PreparedGroup -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe PreparedGroup -> Bool) -> Maybe PreparedGroup -> Bool
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe PreparedGroup
preparedGroup GroupInfo
gInfo) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"group doesn't have link to connect"
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Connection -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Connection -> Bool) -> Maybe Connection -> Bool
forall a b. (a -> b) -> a -> b
$ GroupMember -> Maybe Connection
memberConn GroupMember
hostMember) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"host member already has connection"
    User
newUser <- Int64 -> CM User
privateGetUser Int64
newUserId
    GroupInfo
gInfo' <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> User
-> ExceptT StoreError IO GroupInfo
updatePreparedGroupUser Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
hostMember User
newUser
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> User -> GroupInfo -> ChatResponse
CRGroupUserChanged User
user GroupInfo
gInfo User
newUser GroupInfo
gInfo'
  APIConnectPreparedContact Int64
contactId Bool
incognito Maybe MsgContent
msgContent_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {Maybe PreparedContact
preparedContact :: Contact -> Maybe PreparedContact
preparedContact :: Maybe PreparedContact
preparedContact} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    case Maybe PreparedContact
preparedContact of
      Maybe PreparedContact
Nothing -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"contact doesn't have link to connect"
      Just PreparedContact {connLinkToConnect :: PreparedContact -> ACreatedConnLink
connLinkToConnect = ACCL SConnectionMode m
SCMInvitation CreatedConnLink m
ccLink} -> do
        (Connection
_, Maybe Profile
customUserProfile) <- User
-> Bool
-> CreatedConnLink 'CMInvitation
-> Maybe Int64
-> CM (Connection, Maybe Profile)
connectViaInvitation User
user Bool
incognito CreatedConnLink m
CreatedConnLink 'CMInvitation
ccLink (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
contactId) CM (Connection, Maybe Profile)
-> (ChatError -> CM (Connection, Maybe Profile))
-> CM (Connection, Maybe Profile)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
e -> do
          -- get updated contact, in case connection was started - in UI it would lock ability to change
          -- user or incognito profile for contact, in case server received request while client got network error
          Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
          ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatEvent
CEvtChatInfoUpdated User
user (SChatType 'CTDirect -> ChatInfo 'CTDirect -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect -> AChatInfo)
-> ChatInfo 'CTDirect -> AChatInfo
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct')
          ChatError -> CM (Connection, Maybe Profile)
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
        -- get updated contact with connection
        Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
        -- create changed feature items (connecting incognito sends default preferences, instead of user preferences)
        ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
incognito (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Contact -> ReaderT ChatController IO ()
createContactChangedFeatureItems User
user Contact
ct Contact
ct'
        Maybe MsgContent
-> (MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe MsgContent
msgContent_ ((MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \MsgContent
mc -> do
          let evt :: ChatMsgEvent 'Json
evt = MsgContainer -> ChatMsgEvent 'Json
XMsgNew (MsgContainer -> ChatMsgEvent 'Json)
-> MsgContainer -> ChatMsgEvent 'Json
forall a b. (a -> b) -> a -> b
$ ExtMsgContent -> MsgContainer
MCSimple (MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent MsgContent
mc Maybe FileInvitation
forall a. Maybe a
Nothing)
          (SndMessage
msg, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct' ChatMsgEvent 'Json
evt
          ChatItem 'CTDirect 'MDSnd
ci <- User
-> ChatDirection 'CTDirect 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem 'CTDirect 'MDSnd)
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem c 'MDSnd)
saveSndChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct') SndMessage
msg (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc)
          ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct') ChatItem 'CTDirect 'MDSnd
ci]
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Maybe Profile -> ChatResponse
CRStartedConnectionToContact User
user Contact
ct' Maybe Profile
customUserProfile
      Just PreparedContact {connLinkToConnect :: PreparedContact -> ACreatedConnLink
connLinkToConnect = ACCL SConnectionMode m
SCMContact CreatedConnLink m
ccLink, Maybe SharedMsgId
welcomeSharedMsgId :: Maybe SharedMsgId
welcomeSharedMsgId :: PreparedContact -> Maybe SharedMsgId
welcomeSharedMsgId, Maybe SharedMsgId
requestSharedMsgId :: Maybe SharedMsgId
requestSharedMsgId :: PreparedContact -> Maybe SharedMsgId
requestSharedMsgId} -> do
        Maybe (SharedMsgId, MsgContent)
msg_ <- Maybe MsgContent
-> (MsgContent
    -> ExceptT
         ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (SharedMsgId, MsgContent))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe MsgContent
msgContent_ ((MsgContent
  -> ExceptT
       ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe (SharedMsgId, MsgContent)))
-> (MsgContent
    -> ExceptT
         ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (SharedMsgId, MsgContent))
forall a b. (a -> b) -> a -> b
$ \MsgContent
mc -> case Maybe SharedMsgId
requestSharedMsgId of
          Just SharedMsgId
smId -> (SharedMsgId, MsgContent)
-> ExceptT
     ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SharedMsgId
smId, MsgContent
mc)
          Maybe SharedMsgId
Nothing -> do
            SharedMsgId
smId <- ExceptT ChatError (ReaderT ChatController IO) SharedMsgId
getSharedMsgId
            (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> SharedMsgId -> IO ()
setRequestSharedMsgIdForContact Connection
db Int64
contactId SharedMsgId
smId
            (SharedMsgId, MsgContent)
-> ExceptT
     ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SharedMsgId
smId, MsgContent
mc)
        ConnectViaContactResult
r <- User
-> Maybe PreparedChatEntity
-> Bool
-> CreatedLinkContact
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> CM ConnectViaContactResult
connectViaContact User
user (PreparedChatEntity -> Maybe PreparedChatEntity
forall a. a -> Maybe a
Just (PreparedChatEntity -> Maybe PreparedChatEntity)
-> PreparedChatEntity -> Maybe PreparedChatEntity
forall a b. (a -> b) -> a -> b
$ Contact -> PreparedChatEntity
PCEContact Contact
ct) Bool
incognito CreatedConnLink m
CreatedLinkContact
ccLink Maybe SharedMsgId
welcomeSharedMsgId Maybe (SharedMsgId, MsgContent)
msg_ CM ConnectViaContactResult
-> (ChatError -> CM ConnectViaContactResult)
-> CM ConnectViaContactResult
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
e -> do
          -- get updated contact, in case connection was started - in UI it would lock ability to change
          -- user or incognito profile for contact, in case server received request while client got network error
          Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
          ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatEvent
CEvtChatInfoUpdated User
user (SChatType 'CTDirect -> ChatInfo 'CTDirect -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect -> AChatInfo)
-> ChatInfo 'CTDirect -> AChatInfo
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct')
          ChatError -> CM ConnectViaContactResult
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
        case ConnectViaContactResult
r of
          CVRSentInvitation Connection
_conn Maybe Profile
customUserProfile -> do
            -- get updated contact with connection
            Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
            -- create changed feature items (connecting incognito sends default preferences, instead of user preferences)
            ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
incognito (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Contact -> ReaderT ChatController IO ()
createContactChangedFeatureItems User
user Contact
ct Contact
ct'
            Maybe (SharedMsgId, MsgContent)
-> ((SharedMsgId, MsgContent)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (SharedMsgId, MsgContent)
msg_ (((SharedMsgId, MsgContent)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((SharedMsgId, MsgContent)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(SharedMsgId
sharedMsgId, MsgContent
mc) -> do
              AChatItem
ci <- User
-> ChatDirection 'CTDirect 'MDSnd
-> Bool
-> CIContent 'MDSnd
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct') Bool
False (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc) (SharedMsgId -> Maybe SharedMsgId
forall a. a -> Maybe a
Just SharedMsgId
sharedMsgId) Maybe UTCTime
forall a. Maybe a
Nothing
              ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [Item [AChatItem]
AChatItem
ci]
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Maybe Profile -> ChatResponse
CRStartedConnectionToContact User
user Contact
ct' Maybe Profile
customUserProfile
          CVRConnectedContact Contact
ct' -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRContactAlreadyExists User
user Contact
ct'
  APIConnectPreparedGroup Int64
groupId Bool
incognito Maybe MsgContent
msgContent_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
gInfo, GroupMember
hostMember) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupMember
getHostMember Connection
db VersionRangeChat
vr User
user Int64
groupId
    case GroupInfo -> Maybe PreparedGroup
preparedGroup GroupInfo
gInfo of
      Maybe PreparedGroup
Nothing -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"group doesn't have link to connect"
      Just PreparedGroup {CreatedLinkContact
connLinkToConnect :: CreatedLinkContact
connLinkToConnect :: PreparedGroup -> CreatedLinkContact
connLinkToConnect, Maybe SharedMsgId
welcomeSharedMsgId :: Maybe SharedMsgId
welcomeSharedMsgId :: PreparedGroup -> Maybe SharedMsgId
welcomeSharedMsgId, Maybe SharedMsgId
requestSharedMsgId :: Maybe SharedMsgId
requestSharedMsgId :: PreparedGroup -> Maybe SharedMsgId
requestSharedMsgId} -> do
        Maybe (SharedMsgId, MsgContent)
msg_ <- Maybe MsgContent
-> (MsgContent
    -> ExceptT
         ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (SharedMsgId, MsgContent))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe MsgContent
msgContent_ ((MsgContent
  -> ExceptT
       ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Maybe (SharedMsgId, MsgContent)))
-> (MsgContent
    -> ExceptT
         ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (SharedMsgId, MsgContent))
forall a b. (a -> b) -> a -> b
$ \MsgContent
mc -> case Maybe SharedMsgId
requestSharedMsgId of
          Just SharedMsgId
smId -> (SharedMsgId, MsgContent)
-> ExceptT
     ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SharedMsgId
smId, MsgContent
mc)
          Maybe SharedMsgId
Nothing -> do
            SharedMsgId
smId <- ExceptT ChatError (ReaderT ChatController IO) SharedMsgId
getSharedMsgId
            (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> SharedMsgId -> IO ()
setRequestSharedMsgIdForGroup Connection
db Int64
groupId SharedMsgId
smId
            (SharedMsgId, MsgContent)
-> ExceptT
     ChatError (ReaderT ChatController IO) (SharedMsgId, MsgContent)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SharedMsgId
smId, MsgContent
mc)
        ConnectViaContactResult
r <- User
-> Maybe PreparedChatEntity
-> Bool
-> CreatedLinkContact
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> CM ConnectViaContactResult
connectViaContact User
user (PreparedChatEntity -> Maybe PreparedChatEntity
forall a. a -> Maybe a
Just (PreparedChatEntity -> Maybe PreparedChatEntity)
-> PreparedChatEntity -> Maybe PreparedChatEntity
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMember -> PreparedChatEntity
PCEGroup GroupInfo
gInfo GroupMember
hostMember) Bool
incognito CreatedLinkContact
connLinkToConnect Maybe SharedMsgId
welcomeSharedMsgId Maybe (SharedMsgId, MsgContent)
msg_ CM ConnectViaContactResult
-> (ChatError -> CM ConnectViaContactResult)
-> CM ConnectViaContactResult
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
e -> do
          -- get updated group info, in case connection was started (connLinkPreparedConnection) - in UI it would lock ability to change
          -- user or incognito profile for group or business chat, in case server received request while client got network error
          GroupInfo
gInfo' <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
          ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatEvent
CEvtChatInfoUpdated User
user (SChatType 'CTGroup -> ChatInfo 'CTGroup -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTGroup
SCTGroup (ChatInfo 'CTGroup -> AChatInfo) -> ChatInfo 'CTGroup -> AChatInfo
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo' Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing)
          ChatError -> CM ConnectViaContactResult
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
        case ConnectViaContactResult
r of
          CVRSentInvitation Connection
_conn Maybe Profile
customUserProfile -> do
            -- get updated group info (connLinkStartedConnection and incognito membership)
            GroupInfo
gInfo' <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
              IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Int64 -> IO ()
setPreparedGroupStartedConnection Connection
db Int64
groupId
              Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
            Maybe (SharedMsgId, MsgContent)
-> ((SharedMsgId, MsgContent)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (SharedMsgId, MsgContent)
msg_ (((SharedMsgId, MsgContent)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((SharedMsgId, MsgContent)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(SharedMsgId
sharedMsgId, MsgContent
mc) -> do
              AChatItem
ci <- User
-> ChatDirection 'CTGroup 'MDSnd
-> Bool
-> CIContent 'MDSnd
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo' Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing) Bool
False (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc) (SharedMsgId -> Maybe SharedMsgId
forall a. a -> Maybe a
Just SharedMsgId
sharedMsgId) Maybe UTCTime
forall a. Maybe a
Nothing
              ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [Item [AChatItem]
AChatItem
ci]
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> Maybe Profile -> ChatResponse
CRStartedConnectionToGroup User
user GroupInfo
gInfo' Maybe Profile
customUserProfile
          CVRConnectedContact Contact
_ct -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ String -> ChatErrorType
CEException String
"contact already exists when connecting to group"
  APIConnect Int64
userId Bool
incognito (Just ACreatedConnLink
acl) -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> case ACreatedConnLink
acl of
    ACCL SConnectionMode m
SCMInvitation CreatedConnLink m
ccLink -> do
      (Connection
conn, Maybe Profile
incognitoProfile) <- User
-> Bool
-> CreatedConnLink 'CMInvitation
-> Maybe Int64
-> CM (Connection, Maybe Profile)
connectViaInvitation User
user Bool
incognito CreatedConnLink m
CreatedConnLink 'CMInvitation
ccLink Maybe Int64
forall a. Maybe a
Nothing
      let pcc :: PendingContactConnection
pcc = Connection
-> Maybe (CreatedConnLink 'CMInvitation)
-> PendingContactConnection
mkPendingContactConnection Connection
conn (Maybe (CreatedConnLink 'CMInvitation) -> PendingContactConnection)
-> Maybe (CreatedConnLink 'CMInvitation)
-> PendingContactConnection
forall a b. (a -> b) -> a -> b
$ CreatedConnLink 'CMInvitation
-> Maybe (CreatedConnLink 'CMInvitation)
forall a. a -> Maybe a
Just CreatedConnLink m
CreatedConnLink 'CMInvitation
ccLink
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> PendingContactConnection -> Maybe Profile -> ChatResponse
CRSentConfirmation User
user PendingContactConnection
pcc Maybe Profile
incognitoProfile
    ACCL SConnectionMode m
SCMContact CreatedConnLink m
ccLink ->
      User
-> Maybe PreparedChatEntity
-> Bool
-> CreatedLinkContact
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> CM ConnectViaContactResult
connectViaContact User
user Maybe PreparedChatEntity
forall a. Maybe a
Nothing Bool
incognito CreatedConnLink m
CreatedLinkContact
ccLink Maybe SharedMsgId
forall a. Maybe a
Nothing Maybe (SharedMsgId, MsgContent)
forall a. Maybe a
Nothing CM ConnectViaContactResult
-> (ConnectViaContactResult -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        CVRConnectedContact Contact
ct -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRContactAlreadyExists User
user Contact
ct
        CVRSentInvitation Connection
conn Maybe Profile
incognitoProfile -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> PendingContactConnection -> Maybe Profile -> ChatResponse
CRSentInvitation User
user (Connection
-> Maybe (CreatedConnLink 'CMInvitation)
-> PendingContactConnection
mkPendingContactConnection Connection
conn Maybe (CreatedConnLink 'CMInvitation)
forall a. Maybe a
Nothing) Maybe Profile
incognitoProfile
  APIConnect Int64
_ Bool
_ Maybe ACreatedConnLink
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidConnReq
  Connect Bool
incognito (Just cLink :: AConnectionLink
cLink@(ACL SConnectionMode m
m ConnectionLink m
cLink')) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (ACreatedConnLink
ccLink, ConnectionPlan
plan) <- User
-> AConnectionLink
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
connectPlan User
user AConnectionLink
cLink ExceptT
  ChatError
  (ReaderT ChatController IO)
  (ACreatedConnLink, ConnectionPlan)
-> (ChatError
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (ACreatedConnLink, ConnectionPlan))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
e -> case ConnectionLink m
cLink' of CLFull ConnectionRequestUri m
cReq -> (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode m
m (ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnectionRequestUri m
cReq Maybe (ConnShortLink m)
forall a. Maybe a
Nothing), InvitationLinkPlan -> ConnectionPlan
CPInvitationLink (Maybe ContactShortLinkData -> InvitationLinkPlan
ILPOk Maybe ContactShortLinkData
forall a. Maybe a
Nothing)); ConnectionLink m
_ -> ChatError
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
    User
-> Bool -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
connectWithPlan User
user Bool
incognito ACreatedConnLink
ccLink ConnectionPlan
plan
  Connect Bool
_ Maybe AConnectionLink
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidConnReq
  APIConnectContactViaAddress Int64
userId Bool
incognito Int64
contactId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {profile :: Contact -> LocalProfile
profile = LocalProfile {Maybe ConnLinkContact
contactLink :: Maybe ConnLinkContact
contactLink :: LocalProfile -> Maybe ConnLinkContact
contactLink}} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    CreatedLinkContact
ccLink <- case Maybe ConnLinkContact
contactLink of
      Just (CLFull ConnReqContact
cReq) -> CreatedLinkContact
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CreatedLinkContact
 -> ExceptT
      ChatError (ReaderT ChatController IO) CreatedLinkContact)
-> CreatedLinkContact
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall a b. (a -> b) -> a -> b
$ ConnReqContact
-> Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqContact
cReq Maybe (ConnShortLink 'CMContact)
forall a. Maybe a
Nothing
      Just (CLShort ConnShortLink 'CMContact
sLnk) -> do
        (ConnReqContact
cReq, ConnLinkData 'CMContact
_cData) <- User
-> ConnShortLink 'CMContact
-> CM (ConnReqContact, ConnLinkData 'CMContact)
forall (m :: ConnectionMode).
User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
getShortLinkConnReq User
user ConnShortLink 'CMContact
sLnk
        CreatedLinkContact
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CreatedLinkContact
 -> ExceptT
      ChatError (ReaderT ChatController IO) CreatedLinkContact)
-> CreatedLinkContact
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall a b. (a -> b) -> a -> b
$ ConnReqContact
-> Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqContact
cReq (Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact)
-> Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact
forall a b. (a -> b) -> a -> b
$ ConnShortLink 'CMContact -> Maybe (ConnShortLink 'CMContact)
forall a. a -> Maybe a
Just ConnShortLink 'CMContact
sLnk
      Maybe ConnLinkContact
Nothing -> String
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall a. String -> CM a
throwCmdError String
"no address in contact profile"
    User -> Bool -> Contact -> CreatedLinkContact -> CM ChatResponse
connectContactViaAddress User
user Bool
incognito Contact
ct CreatedLinkContact
ccLink CM ChatResponse
-> (ChatError -> CM ChatResponse) -> CM ChatResponse
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
e -> do
      -- get updated contact, in case connection was started - in UI it would lock ability to change incognito choice
      -- on next connection attempt, in case server received request while client got network error
      Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
      ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatEvent
CEvtChatInfoUpdated User
user (SChatType 'CTDirect -> ChatInfo 'CTDirect -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect -> AChatInfo)
-> ChatInfo 'CTDirect -> AChatInfo
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct')
      ChatError -> CM ChatResponse
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
  ConnectSimplex Bool
incognito -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ConnectionPlan
plan <- User
-> ConnReqContact
-> Maybe ContactShortLinkData
-> CM ConnectionPlan
contactRequestPlan User
user ConnReqContact
adminContactReq Maybe ContactShortLinkData
forall a. Maybe a
Nothing CM ConnectionPlan
-> (ChatError -> CM ConnectionPlan) -> CM ConnectionPlan
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` CM ConnectionPlan -> ChatError -> CM ConnectionPlan
forall a b. a -> b -> a
const (ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress (Maybe ContactShortLinkData -> ContactAddressPlan
CAPOk Maybe ContactShortLinkData
forall a. Maybe a
Nothing))
    User
-> Bool -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
connectWithPlan User
user Bool
incognito (SConnectionMode 'CMContact
-> CreatedLinkContact -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode 'CMContact
SCMContact (ConnReqContact
-> Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqContact
adminContactReq Maybe (ConnShortLink 'CMContact)
forall a. Maybe a
Nothing)) ConnectionPlan
plan
  DeleteContact Text
cName ChatDeleteMode
cdm -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName ((Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
ctId -> ChatRef -> ChatDeleteMode -> ChatCommand
APIDeleteChat (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
ctId Maybe GroupChatScope
forall a. Maybe a
Nothing) ChatDeleteMode
cdm
  ClearContact Text
cName -> Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName ((Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
chatId -> ChatRef -> ChatCommand
APIClearChat (ChatRef -> ChatCommand) -> ChatRef -> ChatCommand
forall a b. (a -> b) -> a -> b
$ ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
chatId Maybe GroupChatScope
forall a. Maybe a
Nothing
  APIListContacts Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> [Contact] -> ChatResponse
CRContactsList User
user ([Contact] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [Contact])
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection -> VersionRangeChat -> User -> IO [Contact]
getUserContacts Connection
db VersionRangeChat
vr User
user)
  ChatCommand
ListContacts -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIListContacts Int64
userId
  APICreateMyAddress Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Connection -> IO (Either StoreError UserContactLink))
-> CM (Either StoreError UserContactLink)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> ExceptT StoreError IO UserContactLink
-> IO (Either StoreError UserContactLink)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO UserContactLink
 -> IO (Either StoreError UserContactLink))
-> ExceptT StoreError IO UserContactLink
-> IO (Either StoreError UserContactLink)
forall a b. (a -> b) -> a -> b
$ Connection -> User -> ExceptT StoreError IO UserContactLink
getUserAddress Connection
db User
user) CM (Either StoreError UserContactLink)
-> (Either StoreError UserContactLink
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left StoreError
SEUserContactLinkNotFound -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Left StoreError
e -> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ChatError
ChatErrorStore StoreError
e
      Right UserContactLink
_ -> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ StoreError -> ChatError
ChatErrorStore StoreError
SEDuplicateContactLink
    SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
    let userData :: UserLinkData
userData = Profile -> Maybe AddressSettings -> UserLinkData
contactShortLinkData (User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user Maybe Profile
forall a. Maybe a
Nothing Maybe Contact
forall a. Maybe a
Nothing Bool
True) Maybe AddressSettings
forall a. Maybe a
Nothing
        userLinkData :: UserConnLinkData 'CMContact
userLinkData = UserContactData -> UserConnLinkData 'CMContact
UserContactLinkData UserContactData {direct :: Bool
direct = Bool
True, owners :: [OwnerAuth]
owners = [], relays :: [ConnShortLink 'CMContact]
relays = [], UserLinkData
userData :: UserLinkData
userData :: UserLinkData
userData}
    -- TODO [certs rcv]
    (ByteString
connId, (CreatedLinkContact
ccLink, Maybe (DBEntityId' 'DBStored)
_serviceId)) <- (AgentClient
 -> ExceptT
      AgentErrorType
      IO
      (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored)))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT
       AgentErrorType
       IO
       (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
 -> CM
      (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
-> (AgentClient
    -> ExceptT
         AgentErrorType
         IO
         (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored)))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode 'CMContact
-> Maybe (UserConnLinkData 'CMContact)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> ExceptT
     AgentErrorType
     IO
     (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored)))
forall (c :: ConnectionMode).
ConnectionModeI c =>
AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode c
-> Maybe (UserConnLinkData c)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> AE
     (ByteString, (CreatedConnLink c, Maybe (DBEntityId' 'DBStored)))
createConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) Bool
True Bool
True SConnectionMode 'CMContact
SCMContact (UserConnLinkData 'CMContact -> Maybe (UserConnLinkData 'CMContact)
forall a. a -> Maybe a
Just UserConnLinkData 'CMContact
userLinkData) Maybe Text
forall a. Maybe a
Nothing InitialKeys
IKPQOn SubscriptionMode
subMode
    CreatedLinkContact
ccLink' <- CreatedLinkContact
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall (m :: ConnectionMode).
CreatedConnLink m -> CM (CreatedConnLink m)
shortenCreatedLink CreatedLinkContact
ccLink
    (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> ByteString
-> CreatedLinkContact
-> SubscriptionMode
-> ExceptT StoreError IO ()
createUserContactLink Connection
db User
user ByteString
connId CreatedLinkContact
ccLink' SubscriptionMode
subMode
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> CreatedLinkContact -> ChatResponse
CRUserContactLinkCreated User
user CreatedLinkContact
ccLink'
  ChatCommand
CreateMyAddress -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APICreateMyAddress Int64
userId
  APIDeleteMyAddress Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {profile :: User -> LocalProfile
profile = LocalProfile
p} -> do
    Connection
conn <- (Connection -> ExceptT StoreError IO Connection) -> CM Connection
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Connection) -> CM Connection)
-> (Connection -> ExceptT StoreError IO Connection)
-> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> ExceptT StoreError IO Connection
getUserAddressConnection Connection
db VersionRangeChat
vr User
user
    Text
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. Text -> CM a -> CM a
withChatLock Text
"deleteMyAddress" (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
      ByteString -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteAgentConnectionAsync (ByteString -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ByteString -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
aConnId Connection
conn
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO ()
`deleteUserAddress` User
user)
    let p' :: Profile
p' = (LocalProfile -> Profile
fromLocalProfile LocalProfile
p :: Profile) {contactLink = Nothing}
    ChatResponse
r <- User -> Profile -> Bool -> CM User -> CM ChatResponse
updateProfile_ User
user Profile
p' Bool
False (CM User -> CM ChatResponse) -> CM User -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ (Connection -> IO User) -> CM User
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO User) -> CM User)
-> (Connection -> IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Maybe UserContactLink -> IO User
setUserProfileContactLink Connection
db User
user Maybe UserContactLink
forall a. Maybe a
Nothing
    let user' :: User
user' = case ChatResponse
r of
          CRUserProfileUpdated User
u' Profile
_ Profile
_ UserProfileUpdateSummary
_ -> User
u'
          ChatResponse
_ -> User
user
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> ChatResponse
CRUserContactLinkDeleted User
user'
  ChatCommand
DeleteMyAddress -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIDeleteMyAddress Int64
userId
  APIShowMyAddress Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId' Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> UserContactLink -> ChatResponse
CRUserContactLink User
user (UserContactLink -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO UserContactLink)
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO UserContactLink
`getUserAddress` User
user)
  ChatCommand
ShowMyAddress -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIShowMyAddress Int64
userId
  APIAddMyAddressShortLink Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId' Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> UserContactLink -> ChatResponse
CRUserContactLink User
user (UserContactLink -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Connection -> ExceptT StoreError IO UserContactLink)
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO UserContactLink
`getUserAddress` User
user) ExceptT ChatError (ReaderT ChatController IO) UserContactLink
-> (UserContactLink
    -> ExceptT ChatError (ReaderT ChatController IO) UserContactLink)
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= User
-> UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
setMyAddressData User
user)
  APISetProfileAddress Int64
userId Bool
False -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {profile :: User -> LocalProfile
profile = LocalProfile
p} -> do
    let p' :: Profile
p' = (LocalProfile -> Profile
fromLocalProfile LocalProfile
p :: Profile) {contactLink = Nothing}
    User -> Profile -> Bool -> CM User -> CM ChatResponse
updateProfile_ User
user Profile
p' Bool
True (CM User -> CM ChatResponse) -> CM User -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ (Connection -> IO User) -> CM User
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO User) -> CM User)
-> (Connection -> IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Maybe UserContactLink -> IO User
setUserProfileContactLink Connection
db User
user Maybe UserContactLink
forall a. Maybe a
Nothing
  APISetProfileAddress Int64
userId Bool
True -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {profile :: User -> LocalProfile
profile = LocalProfile
p} -> do
    UserContactLink
ucl <- (Connection -> ExceptT StoreError IO UserContactLink)
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO UserContactLink
`getUserAddress` User
user)
    -- TODO [short links] replace with short links
    let p' :: Profile
p' = (LocalProfile -> Profile
fromLocalProfile LocalProfile
p :: Profile) {contactLink = Just $ profileContactLink ucl}
    User -> Profile -> Bool -> CM User -> CM ChatResponse
updateProfile_ User
user Profile
p' Bool
True (CM User -> CM ChatResponse) -> CM User -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ (Connection -> IO User) -> CM User
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO User) -> CM User)
-> (Connection -> IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Maybe UserContactLink -> IO User
setUserProfileContactLink Connection
db User
user (Maybe UserContactLink -> IO User)
-> Maybe UserContactLink -> IO User
forall a b. (a -> b) -> a -> b
$ UserContactLink -> Maybe UserContactLink
forall a. a -> Maybe a
Just UserContactLink
ucl
  SetProfileAddress Bool
onOff -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> ChatCommand
APISetProfileAddress Int64
userId Bool
onOff
  APISetAddressSettings Int64
userId settings :: AddressSettings
settings@AddressSettings {Bool
businessAddress :: Bool
businessAddress :: AddressSettings -> Bool
businessAddress, Maybe AutoAccept
autoAccept :: Maybe AutoAccept
autoAccept :: AddressSettings -> Maybe AutoAccept
autoAccept} -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ucl :: UserContactLink
ucl@UserContactLink {Int64
userContactLinkId :: Int64
userContactLinkId :: UserContactLink -> Int64
userContactLinkId, Bool
shortLinkDataSet :: UserContactLink -> Bool
shortLinkDataSet :: Bool
shortLinkDataSet, AddressSettings
addressSettings :: UserContactLink -> AddressSettings
addressSettings :: AddressSettings
addressSettings} <- (Connection -> ExceptT StoreError IO UserContactLink)
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO UserContactLink
`getUserAddress` User
user)
    Maybe AutoAccept
-> (AutoAccept -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe AutoAccept
autoAccept ((AutoAccept -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (AutoAccept -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \AutoAccept {Bool
acceptIncognito :: Bool
acceptIncognito :: AutoAccept -> Bool
acceptIncognito} -> do
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
shortLinkDataSet Bool -> Bool -> Bool
&& Bool
acceptIncognito) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"incognito not allowed for address with short link data"
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
businessAddress Bool -> Bool -> Bool
&& Bool
acceptIncognito) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"requests to business address cannot be accepted incognito"
    if AddressSettings
addressSettings AddressSettings -> AddressSettings -> Bool
forall a. Eq a => a -> a -> Bool
== AddressSettings
settings
      then ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> UserContactLink -> ChatResponse
CRUserContactLinkUpdated User
user UserContactLink
ucl
      else do
        let ucl' :: UserContactLink
ucl' = UserContactLink
ucl {addressSettings = settings}
        UserContactLink
ucl'' <- if Bool
shortLinkDataSet then User
-> UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
setMyAddressData User
user UserContactLink
ucl' else UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserContactLink
ucl'
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> AddressSettings -> IO ()
updateUserAddressSettings Connection
db Int64
userContactLinkId AddressSettings
settings
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> UserContactLink -> ChatResponse
CRUserContactLinkUpdated User
user UserContactLink
ucl''
  SetAddressSettings AddressSettings
settings -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> AddressSettings -> ChatCommand
APISetAddressSettings Int64
userId AddressSettings
settings
  AcceptContact Bool
incognito Text
cName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    Int64
connReqId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Text -> ExceptT StoreError IO Int64
getContactRequestIdByName Connection
db Int64
userId Text
cName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Bool -> Int64 -> ChatCommand
APIAcceptContact Bool
incognito Int64
connReqId
  RejectContact Text
cName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    Int64
connReqId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Text -> ExceptT StoreError IO Int64
getContactRequestIdByName Connection
db Int64
userId Text
cName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIRejectContact Int64
connReqId
  ForwardMessage ChatName
toChatName Text
fromContactName Text
forwardedMsg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
contactId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
fromContactName
    Int64
forwardedItemId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getDirectChatItemIdByText' Connection
db User
user Int64
contactId Text
forwardedMsg
    ChatRef
toChatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
toChatName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand
APIForwardChatItems ChatRef
toChatRef (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing) (Int64
forwardedItemId Int64 -> [Int64] -> NonEmpty Int64
forall a. a -> [a] -> NonEmpty a
:| []) Maybe Int
forall a. Maybe a
Nothing
  ForwardGroupMessage ChatName
toChatName Text
fromGroupName Maybe Text
fromMemberName_ Text
forwardedMsg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
fromGroupName
    Int64
forwardedItemId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> Int64
-> Maybe Text
-> Text
-> ExceptT StoreError IO Int64
getGroupChatItemIdByText Connection
db User
user Int64
groupId Maybe Text
fromMemberName_ Text
forwardedMsg
    ChatRef
toChatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
toChatName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand
APIForwardChatItems ChatRef
toChatRef (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup Int64
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing) (Int64
forwardedItemId Int64 -> [Int64] -> NonEmpty Int64
forall a. a -> [a] -> NonEmpty a
:| []) Maybe Int
forall a. Maybe a
Nothing
  ForwardLocalMessage ChatName
toChatName Text
forwardedMsg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
folderId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO Int64
`getUserNoteFolderId` User
user)
    Int64
forwardedItemId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getLocalChatItemIdByText' Connection
db User
user Int64
folderId Text
forwardedMsg
    ChatRef
toChatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
toChatName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand
APIForwardChatItems ChatRef
toChatRef (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTLocal Int64
folderId Maybe GroupChatScope
forall a. Maybe a
Nothing) (Int64
forwardedItemId Int64 -> [Int64] -> NonEmpty Int64
forall a. a -> [a] -> NonEmpty a
:| []) Maybe Int
forall a. Maybe a
Nothing
  SendMessage SendName
sendName Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    let mc :: MsgContent
mc = Text -> MsgContent
MCText Text
msg
    case SendName
sendName of
      SNDirect Text
name ->
        (Connection -> IO (Either StoreError Int64))
-> CM (Either StoreError Int64)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> ExceptT StoreError IO Int64 -> IO (Either StoreError Int64)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO Int64 -> IO (Either StoreError Int64))
-> ExceptT StoreError IO Int64 -> IO (Either StoreError Int64)
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
name) CM (Either StoreError Int64)
-> (Either StoreError Int64 -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Right Int64
ctId -> do
            let sendRef :: SendRef
sendRef = Int64 -> SendRef
SRDirect Int64
ctId
            VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages SendRef
sendRef Bool
False Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage Maybe CryptoFile
forall a. Maybe a
Nothing MsgContent
mc]
          Left StoreError
_ ->
            (Connection -> IO (Either StoreError [(GroupInfo, GroupMember)]))
-> CM (Either StoreError [(GroupInfo, GroupMember)])
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
-> IO (Either StoreError [(GroupInfo, GroupMember)])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO [(GroupInfo, GroupMember)]
 -> IO (Either StoreError [(GroupInfo, GroupMember)]))
-> ExceptT StoreError IO [(GroupInfo, GroupMember)]
-> IO (Either StoreError [(GroupInfo, GroupMember)])
forall a b. (a -> b) -> a -> b
$ Connection
-> VersionRangeChat
-> User
-> Text
-> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName Connection
db VersionRangeChat
vr User
user Text
name) CM (Either StoreError [(GroupInfo, GroupMember)])
-> (Either StoreError [(GroupInfo, GroupMember)]
    -> CM ChatResponse)
-> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Right [(GroupInfo
gInfo, GroupMember
member)] -> do
                let GroupInfo {localDisplayName :: GroupInfo -> Text
localDisplayName = Text
gName} = GroupInfo
gInfo
                    GroupMember {localDisplayName :: GroupMember -> Text
localDisplayName = Text
mName} = GroupMember
member
                VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> ChatCommand
SendMemberContactMessage Text
gName Text
mName Text
msg
              Right ((GroupInfo, GroupMember)
suspectedMember : [(GroupInfo, GroupMember)]
_) ->
                ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (GroupInfo, GroupMember) -> ChatErrorType
CEContactNotFound Text
name ((GroupInfo, GroupMember) -> Maybe (GroupInfo, GroupMember)
forall a. a -> Maybe a
Just (GroupInfo, GroupMember)
suspectedMember)
              Either StoreError [(GroupInfo, GroupMember)]
_ ->
                ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (GroupInfo, GroupMember) -> ChatErrorType
CEContactNotFound Text
name Maybe (GroupInfo, GroupMember)
forall a. Maybe a
Nothing
      SNGroup Text
name Maybe GroupScopeName
scope_ -> do
        (Int64
gId, Maybe GroupChatScope
cScope_, Map Text Int64
mentions) <- (Connection
 -> ExceptT
      StoreError IO (Int64, Maybe GroupChatScope, Map Text Int64))
-> CM (Int64, Maybe GroupChatScope, Map Text Int64)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError IO (Int64, Maybe GroupChatScope, Map Text Int64))
 -> CM (Int64, Maybe GroupChatScope, Map Text Int64))
-> (Connection
    -> ExceptT
         StoreError IO (Int64, Maybe GroupChatScope, Map Text Int64))
-> CM (Int64, Maybe GroupChatScope, Map Text Int64)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          Int64
gId <- Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
name
          Maybe GroupChatScope
cScope_ <-
            Maybe GroupScopeName
-> (GroupScopeName -> ExceptT StoreError IO GroupChatScope)
-> ExceptT StoreError IO (Maybe GroupChatScope)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe GroupScopeName
scope_ ((GroupScopeName -> ExceptT StoreError IO GroupChatScope)
 -> ExceptT StoreError IO (Maybe GroupChatScope))
-> (GroupScopeName -> ExceptT StoreError IO GroupChatScope)
-> ExceptT StoreError IO (Maybe GroupChatScope)
forall a b. (a -> b) -> a -> b
$ \(GSNMemberSupport Maybe Text
mName_) ->
              Maybe Int64 -> GroupChatScope
GCSMemberSupport (Maybe Int64 -> GroupChatScope)
-> ExceptT StoreError IO (Maybe Int64)
-> ExceptT StoreError IO GroupChatScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ExceptT StoreError IO Int64)
-> Maybe Text -> ExceptT StoreError IO (Maybe Int64)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getGroupMemberIdByName Connection
db User
user Int64
gId) Maybe Text
mName_
          (Int64
gId,Maybe GroupChatScope
cScope_,) (Map Text Int64 -> (Int64, Maybe GroupChatScope, Map Text Int64))
-> ExceptT StoreError IO (Map Text Int64)
-> ExceptT
     StoreError IO (Int64, Maybe GroupChatScope, Map Text Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map Text Int64) -> ExceptT StoreError IO (Map Text Int64)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> User -> Int64 -> Text -> IO (Map Text Int64)
getMessageMentions Connection
db User
user Int64
gId Text
msg)
        let sendRef :: SendRef
sendRef = Int64 -> Maybe GroupChatScope -> SendRef
SRGroup Int64
gId Maybe GroupChatScope
cScope_
        VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages SendRef
sendRef Bool
False Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile
-> Maybe Int64 -> MsgContent -> Map Text Int64 -> ComposedMessage
ComposedMessage Maybe CryptoFile
forall a. Maybe a
Nothing Maybe Int64
forall a. Maybe a
Nothing MsgContent
mc Map Text Int64
mentions]
      SendName
SNLocal -> do
        Int64
folderId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO Int64
`getUserNoteFolderId` User
user)
        VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> NonEmpty ComposedMessage -> ChatCommand
APICreateChatItems Int64
folderId [Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage Maybe CryptoFile
forall a. Maybe a
Nothing MsgContent
mc]
  SendMemberContactMessage Text
gName Text
mName Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Int64
gId, Int64
mId) <- User -> Text -> Text -> CM (Int64, Int64)
getGroupAndMemberId User
user Text
gName Text
mName
    GroupMember
m <- (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
mId
    let mc :: MsgContent
mc = Text -> MsgContent
MCText Text
msg
    case GroupMember -> Maybe Int64
memberContactId GroupMember
m of
      Maybe Int64
Nothing -> do
        GroupInfo
g <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SGroupFeature 'GFDirectMessages -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureUserAllowed SGroupFeature 'GFDirectMessages
SGFDirectMessages GroupInfo
g) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"direct messages not allowed"
        ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ChatEvent
CEvtNoMemberContactCreating User
user GroupInfo
g GroupMember
m
        VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (Int64 -> Int64 -> ChatCommand
APICreateMemberContact Int64
gId Int64
mId) CM ChatResponse
-> (ChatResponse -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          CRNewMemberContact User
_ ct :: Contact
ct@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} GroupInfo
_ GroupMember
_ -> do
            TerminalEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toViewTE (TerminalEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> TerminalEvent
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Contact -> GroupInfo -> GroupMember -> TerminalEvent
TENewMemberContact User
user Contact
ct GroupInfo
g GroupMember
m
            VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe MsgContent -> ChatCommand
APISendMemberContactInvitation Int64
contactId (MsgContent -> Maybe MsgContent
forall a. a -> Maybe a
Just MsgContent
mc)
          ChatResponse
cr -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatResponse
cr
      Just Int64
ctId -> do
        let sendRef :: SendRef
sendRef = Int64 -> SendRef
SRDirect Int64
ctId
        VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages SendRef
sendRef Bool
False Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage Maybe CryptoFile
forall a. Maybe a
Nothing MsgContent
mc]
  AcceptMemberContact Text
cName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
contactId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
cName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIAcceptMemberContact Int64
contactId
  SendLiveMessage ChatName
chatName Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (ChatRef
chatRef, Map Text Int64
mentions) <- User -> ChatName -> Text -> CM (ChatRef, Map Text Int64)
getChatRefAndMentions User
user ChatName
chatName Text
msg
    ChatRef -> (SendRef -> CM ChatResponse) -> CM ChatResponse
withSendRef ChatRef
chatRef ((SendRef -> CM ChatResponse) -> CM ChatResponse)
-> (SendRef -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \SendRef
sendRef -> do
      let mc :: MsgContent
mc = Text -> MsgContent
MCText Text
msg
      VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages SendRef
sendRef Bool
True Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile
-> Maybe Int64 -> MsgContent -> Map Text Int64 -> ComposedMessage
ComposedMessage Maybe CryptoFile
forall a. Maybe a
Nothing Maybe Int64
forall a. Maybe a
Nothing MsgContent
mc Map Text Int64
mentions]
  SendMessageBroadcast MsgContent
mc -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [Contact]
contacts <- (Connection -> IO [Contact])
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [Contact])
 -> ExceptT ChatError (ReaderT ChatController IO) [Contact])
-> (Connection -> IO [Contact])
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> VersionRangeChat -> User -> IO [Contact]
getUserContacts Connection
db VersionRangeChat
vr User
user
    Text -> CM ChatResponse -> CM ChatResponse
forall a. Text -> CM a -> CM a
withChatLock Text
"sendMessageBroadcast" (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      let ctConns_ :: Maybe (NonEmpty (Contact, Connection))
ctConns_ = [(Contact, Connection)] -> Maybe (NonEmpty (Contact, Connection))
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([(Contact, Connection)] -> Maybe (NonEmpty (Contact, Connection)))
-> [(Contact, Connection)]
-> Maybe (NonEmpty (Contact, Connection))
forall a b. (a -> b) -> a -> b
$ (Contact -> [(Contact, Connection)] -> [(Contact, Connection)])
-> [(Contact, Connection)] -> [Contact] -> [(Contact, Connection)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Contact -> [(Contact, Connection)] -> [(Contact, Connection)]
addContactConn [] [Contact]
contacts
      case Maybe (NonEmpty (Contact, Connection))
ctConns_ of
        Maybe (NonEmpty (Contact, Connection))
Nothing -> do
          UTCTime
timestamp <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRBroadcastSent {User
user :: User
user :: User
user, msgContent :: MsgContent
msgContent = MsgContent
mc, successes :: Int
successes = Int
0, failures :: Int
failures = Int
0, UTCTime
timestamp :: UTCTime
timestamp :: UTCTime
timestamp}
        Just (NonEmpty (Contact, Connection)
ctConns :: NonEmpty (Contact, Connection)) -> do
          let idsEvts :: NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
idsEvts = ((Contact, Connection) -> (ConnOrGroupId, ChatMsgEvent 'Json))
-> NonEmpty (Contact, Connection)
-> NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map (Contact, Connection) -> (ConnOrGroupId, ChatMsgEvent 'Json)
ctSndEvent NonEmpty (Contact, Connection)
ctConns
          -- TODO Broadcast rework
          -- In createNewSndMessage and encodeChatMessage we could use Nothing for sharedMsgId,
          -- then we could reuse message body across broadcast.
          -- Encoding different sharedMsgId and reusing body is meaningless as referencing will not work anyway.
          -- As an improvement, single message record with its sharedMsgId could be created for new "broadcast" entity.
          -- Then all recipients could refer to broadcast message using same sharedMsgId.
          NonEmpty (Either ChatError SndMessage)
sndMsgs <- ReaderT ChatController IO (NonEmpty (Either ChatError SndMessage))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage))
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO (NonEmpty (Either ChatError SndMessage))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (Either ChatError SndMessage)))
-> ReaderT
     ChatController IO (NonEmpty (Either ChatError SndMessage))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage))
forall a b. (a -> b) -> a -> b
$ NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
-> ReaderT
     ChatController IO (NonEmpty (Either ChatError SndMessage))
forall (e :: MsgEncoding) (t :: * -> *).
(MsgEncodingI e, Traversable t) =>
t (ConnOrGroupId, ChatMsgEvent e)
-> CM' (t (Either ChatError SndMessage))
createSndMessages NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
idsEvts
          let NonEmpty (Either ChatError ChatMsgReq)
msgReqs_ :: NonEmpty (Either ChatError ChatMsgReq) = ((Contact, Connection)
 -> Either ChatError SndMessage -> Either ChatError ChatMsgReq)
-> NonEmpty (Contact, Connection)
-> NonEmpty (Either ChatError SndMessage)
-> NonEmpty (Either ChatError ChatMsgReq)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
L.zipWith ((SndMessage -> ChatMsgReq)
-> Either ChatError SndMessage -> Either ChatError ChatMsgReq
forall a b. (a -> b) -> Either ChatError a -> Either ChatError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SndMessage -> ChatMsgReq)
 -> Either ChatError SndMessage -> Either ChatError ChatMsgReq)
-> ((Contact, Connection) -> SndMessage -> ChatMsgReq)
-> (Contact, Connection)
-> Either ChatError SndMessage
-> Either ChatError ChatMsgReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Contact, Connection) -> SndMessage -> ChatMsgReq
ctMsgReq) NonEmpty (Contact, Connection)
ctConns NonEmpty (Either ChatError SndMessage)
sndMsgs
          ([ChatError]
errs, [(Contact, SndMessage)]
ctSndMsgs :: [(Contact, SndMessage)]) <-
            [Either ChatError (Contact, SndMessage)]
-> ([ChatError], [(Contact, SndMessage)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError (Contact, SndMessage)]
 -> ([ChatError], [(Contact, SndMessage)]))
-> (NonEmpty (Either ChatError ([Int64], PQEncryption))
    -> [Either ChatError (Contact, SndMessage)])
-> NonEmpty (Either ChatError ([Int64], PQEncryption))
-> ([ChatError], [(Contact, SndMessage)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Either ChatError (Contact, SndMessage))
-> [Either ChatError (Contact, SndMessage)]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty (Either ChatError (Contact, SndMessage))
 -> [Either ChatError (Contact, SndMessage)])
-> (NonEmpty (Either ChatError ([Int64], PQEncryption))
    -> NonEmpty (Either ChatError (Contact, SndMessage)))
-> NonEmpty (Either ChatError ([Int64], PQEncryption))
-> [Either ChatError (Contact, SndMessage)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Contact, Connection)
 -> Either ChatError SndMessage
 -> Either ChatError ([Int64], PQEncryption)
 -> Either ChatError (Contact, SndMessage))
-> NonEmpty (Contact, Connection)
-> NonEmpty (Either ChatError SndMessage)
-> NonEmpty (Either ChatError ([Int64], PQEncryption))
-> NonEmpty (Either ChatError (Contact, SndMessage))
forall a b c d.
(a -> b -> c -> d)
-> NonEmpty a -> NonEmpty b -> NonEmpty c -> NonEmpty d
zipWith3' (Contact, Connection)
-> Either ChatError SndMessage
-> Either ChatError ([Int64], PQEncryption)
-> Either ChatError (Contact, SndMessage)
combineResults NonEmpty (Contact, Connection)
ctConns NonEmpty (Either ChatError SndMessage)
sndMsgs (NonEmpty (Either ChatError ([Int64], PQEncryption))
 -> ([ChatError], [(Contact, SndMessage)]))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError ([Int64], PQEncryption)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [(Contact, SndMessage)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Either ChatError ChatMsgReq)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError ([Int64], PQEncryption)))
deliverMessagesB NonEmpty (Either ChatError ChatMsgReq)
msgReqs_
          UTCTime
timestamp <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
          ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ReaderT ChatController IO [Either ChatError ()]
    -> ReaderT ChatController IO ())
-> ReaderT ChatController IO [Either ChatError ()]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT ChatController IO [Either ChatError ()]
-> ReaderT ChatController IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT ChatController IO [Either ChatError ()]
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO [Either ChatError ()]
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (Connection -> [IO ()])
-> ReaderT ChatController IO [Either ChatError ()]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO a)) -> CM' (t (Either ChatError a))
withStoreBatch' ((Connection -> [IO ()])
 -> ReaderT ChatController IO [Either ChatError ()])
-> (Connection -> [IO ()])
-> ReaderT ChatController IO [Either ChatError ()]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> ((Contact, SndMessage) -> IO ())
-> [(Contact, SndMessage)] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map (Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO ()
createCI Connection
db User
user UTCTime
timestamp) [(Contact, SndMessage)]
ctSndMsgs
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRBroadcastSent {User
user :: User
user :: User
user, msgContent :: MsgContent
msgContent = MsgContent
mc, successes :: Int
successes = [(Contact, SndMessage)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Contact, SndMessage)]
ctSndMsgs, failures :: Int
failures = [ChatError] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChatError]
errs, UTCTime
timestamp :: UTCTime
timestamp :: UTCTime
timestamp}
    where
      addContactConn :: Contact -> [(Contact, Connection)] -> [(Contact, Connection)]
      addContactConn :: Contact -> [(Contact, Connection)] -> [(Contact, Connection)]
addContactConn Contact
ct [(Contact, Connection)]
ctConns = case Contact -> Either ChatError Connection
contactSendConn_ Contact
ct of
        Right Connection
conn | Contact -> Bool
directOrUsed Contact
ct -> (Contact
ct, Connection
conn) (Contact, Connection)
-> [(Contact, Connection)] -> [(Contact, Connection)]
forall a. a -> [a] -> [a]
: [(Contact, Connection)]
ctConns
        Either ChatError Connection
_ -> [(Contact, Connection)]
ctConns
      ctSndEvent :: (Contact, Connection) -> (ConnOrGroupId, ChatMsgEvent 'Json)
      ctSndEvent :: (Contact, Connection) -> (ConnOrGroupId, ChatMsgEvent 'Json)
ctSndEvent (Contact
_, Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId}) = (Int64 -> ConnOrGroupId
ConnectionId Int64
connId, MsgContainer -> ChatMsgEvent 'Json
XMsgNew (MsgContainer -> ChatMsgEvent 'Json)
-> MsgContainer -> ChatMsgEvent 'Json
forall a b. (a -> b) -> a -> b
$ ExtMsgContent -> MsgContainer
MCSimple (MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent MsgContent
mc Maybe FileInvitation
forall a. Maybe a
Nothing))
      ctMsgReq :: (Contact, Connection) -> SndMessage -> ChatMsgReq
      ctMsgReq :: (Contact, Connection) -> SndMessage -> ChatMsgReq
ctMsgReq (Contact
_, Connection
conn) SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId, ByteString
msgBody :: ByteString
msgBody :: SndMessage -> ByteString
msgBody} = (Connection
conn, MsgFlags {notification :: Bool
notification = CMEventTag 'Json -> Bool
forall (e :: MsgEncoding). CMEventTag e -> Bool
hasNotification CMEventTag 'Json
XMsgNew_}, (ByteString -> ValueOrRef ByteString
forall a. a -> ValueOrRef a
vrValue ByteString
msgBody, [Int64
Item [Int64]
msgId]))
      combineResults :: (Contact, Connection) -> Either ChatError SndMessage -> Either ChatError ([Int64], PQEncryption) -> Either ChatError (Contact, SndMessage)
      combineResults :: (Contact, Connection)
-> Either ChatError SndMessage
-> Either ChatError ([Int64], PQEncryption)
-> Either ChatError (Contact, SndMessage)
combineResults (Contact
ct, Connection
_) (Right SndMessage
msg') (Right ([Int64], PQEncryption)
_) = (Contact, SndMessage) -> Either ChatError (Contact, SndMessage)
forall a b. b -> Either a b
Right (Contact
ct, SndMessage
msg')
      combineResults (Contact, Connection)
_ (Left ChatError
e) Either ChatError ([Int64], PQEncryption)
_ = ChatError -> Either ChatError (Contact, SndMessage)
forall a b. a -> Either a b
Left ChatError
e
      combineResults (Contact, Connection)
_ Either ChatError SndMessage
_ (Left ChatError
e) = ChatError -> Either ChatError (Contact, SndMessage)
forall a b. a -> Either a b
Left ChatError
e
      createCI :: DB.Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO ()
      createCI :: Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO ()
createCI Connection
db User
user UTCTime
createdAt (Contact
ct, SndMessage
sndMsg) =
        IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> IO Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> ChatDirection 'CTDirect 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> Maybe (CIQuote 'CTDirect)
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> UTCTime
-> IO Int64
forall (c :: ChatType).
Connection
-> User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> UTCTime
-> IO Int64
createNewSndChatItem Connection
db User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) SndMessage
sndMsg (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc) Maybe (CIQuote 'CTDirect)
forall a. Maybe a
Nothing Maybe CIForwardedFrom
forall a. Maybe a
Nothing Maybe CITimed
forall a. Maybe a
Nothing Bool
False UTCTime
createdAt
  SendMessageQuote Text
cName (AMsgDirection SMsgDirection d
msgDir) Text
quotedMsg Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    Int64
contactId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
cName
    Int64
quotedItemId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64
-> Int64
-> SMsgDirection d
-> Text
-> ExceptT StoreError IO Int64
forall (d :: MsgDirection).
Connection
-> Int64
-> Int64
-> SMsgDirection d
-> Text
-> ExceptT StoreError IO Int64
getDirectChatItemIdByText Connection
db Int64
userId Int64
contactId SMsgDirection d
msgDir Text
quotedMsg
    let mc :: MsgContent
mc = Text -> MsgContent
MCText Text
msg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages (Int64 -> SendRef
SRDirect Int64
contactId) Bool
False Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile
-> Maybe Int64 -> MsgContent -> Map Text Int64 -> ComposedMessage
ComposedMessage Maybe CryptoFile
forall a. Maybe a
Nothing (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
quotedItemId) MsgContent
mc Map Text Int64
forall k a. Map k a
M.empty]
  DeleteMessage ChatName
chatName Text
deletedMsg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    Int64
deletedItemId <- User -> ChatRef -> Text -> CM Int64
getSentChatItemIdByText User
user ChatRef
chatRef Text
deletedMsg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> NonEmpty Int64 -> CIDeleteMode -> ChatCommand
APIDeleteChatItem ChatRef
chatRef (Int64
deletedItemId Int64 -> [Int64] -> NonEmpty Int64
forall a. a -> [a] -> NonEmpty a
:| []) CIDeleteMode
CIDMBroadcast
  DeleteMemberMessage Text
gName Text
mName Text
deletedMsg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
gId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    Int64
deletedItemId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> Int64
-> Maybe Text
-> Text
-> ExceptT StoreError IO Int64
getGroupChatItemIdByText Connection
db User
user Int64
gId (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
mName) Text
deletedMsg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> NonEmpty Int64 -> ChatCommand
APIDeleteMemberChatItem Int64
gId (Int64
deletedItemId Int64 -> [Int64] -> NonEmpty Int64
forall a. a -> [a] -> NonEmpty a
:| [])
  EditMessage ChatName
chatName Text
editedMsg Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (ChatRef
chatRef, Map Text Int64
mentions) <- User -> ChatName -> Text -> CM (ChatRef, Map Text Int64)
getChatRefAndMentions User
user ChatName
chatName Text
msg
    Int64
editedItemId <- User -> ChatRef -> Text -> CM Int64
getSentChatItemIdByText User
user ChatRef
chatRef Text
editedMsg
    let mc :: MsgContent
mc = Text -> MsgContent
MCText Text
msg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> Int64 -> Bool -> UpdatedMessage -> ChatCommand
APIUpdateChatItem ChatRef
chatRef Int64
editedItemId Bool
False (UpdatedMessage -> ChatCommand) -> UpdatedMessage -> ChatCommand
forall a b. (a -> b) -> a -> b
$ MsgContent -> Map Text Int64 -> UpdatedMessage
UpdatedMessage MsgContent
mc Map Text Int64
mentions
  UpdateLiveMessage ChatName
chatName Int64
chatItemId Bool
live Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (ChatRef
chatRef, Map Text Int64
mentions) <- User -> ChatName -> Text -> CM (ChatRef, Map Text Int64)
getChatRefAndMentions User
user ChatName
chatName Text
msg
    let mc :: MsgContent
mc = Text -> MsgContent
MCText Text
msg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> Int64 -> Bool -> UpdatedMessage -> ChatCommand
APIUpdateChatItem ChatRef
chatRef Int64
chatItemId Bool
live (UpdatedMessage -> ChatCommand) -> UpdatedMessage -> ChatCommand
forall a b. (a -> b) -> a -> b
$ MsgContent -> Map Text Int64 -> UpdatedMessage
UpdatedMessage MsgContent
mc Map Text Int64
mentions
  ReactToMessage Bool
add MsgReaction
reaction ChatName
chatName Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    Int64
chatItemId <- User -> ChatRef -> Text -> CM Int64
getChatItemIdByText User
user ChatRef
chatRef Text
msg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> Int64 -> Bool -> MsgReaction -> ChatCommand
APIChatItemReaction ChatRef
chatRef Int64
chatItemId Bool
add MsgReaction
reaction
  APINewGroup Int64
userId Bool
incognito gProfile :: GroupProfile
gProfile@GroupProfile {Text
displayName :: GroupProfile -> Text
displayName :: Text
displayName} -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Text -> ExceptT ChatError (ReaderT ChatController IO) ()
checkValidName Text
displayName
    TVar ChaChaDRG
gVar <- (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random
    -- [incognito] generate incognito profile for group membership
    Maybe Profile
incognitoProfile <- if Bool
incognito then Profile -> Maybe Profile
forall a. a -> Maybe a
Just (Profile -> Maybe Profile)
-> ExceptT ChatError (ReaderT ChatController IO) Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Profile -> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Profile
generateRandomProfile else Maybe Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Profile
forall a. Maybe a
Nothing
    GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> TVar ChaChaDRG
-> User
-> GroupProfile
-> Maybe Profile
-> ExceptT StoreError IO GroupInfo
createNewGroup Connection
db VersionRangeChat
vr TVar ChaChaDRG
gVar User
user GroupProfile
gProfile Maybe Profile
incognitoProfile
    let cd :: ChatDirection 'CTGroup 'MDSnd
cd = GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing
    User
-> ChatDirection 'CTGroup 'MDSnd
-> CIContent 'MDSnd
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user ChatDirection 'CTGroup 'MDSnd
cd CIContent 'MDSnd
CIChatBanner (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
epochStart)
    User
-> ChatDirection 'CTGroup 'MDSnd
-> CIContent 'MDSnd
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user ChatDirection 'CTGroup 'MDSnd
cd (E2EInfo -> CIContent 'MDSnd
CISndGroupE2EEInfo E2EInfo {pqEnabled :: Maybe PQEncryption
pqEnabled = PQEncryption -> Maybe PQEncryption
forall a. a -> Maybe a
Just PQEncryption
PQEncOff}) Maybe UTCTime
forall a. Maybe a
Nothing
    User
-> ChatDirection 'CTGroup 'MDSnd
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent 'MDSnd)
-> GroupInfo
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (d :: MsgDirection).
MsgDirectionI d =>
User
-> ChatDirection 'CTGroup d
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent d)
-> GroupInfo
-> ExceptT ChatError (ReaderT ChatController IO) ()
createGroupFeatureItems User
user ChatDirection 'CTGroup 'MDSnd
cd GroupFeature
-> GroupPreference
-> Maybe Int
-> Maybe GroupMemberRole
-> CIContent 'MDSnd
CISndGroupFeature GroupInfo
gInfo
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> ChatResponse
CRGroupCreated User
user GroupInfo
gInfo
  NewGroup Bool
incognito GroupProfile
gProfile -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> GroupProfile -> ChatCommand
APINewGroup Int64
userId Bool
incognito GroupProfile
gProfile
  APIAddMember Int64
groupId Int64
contactId GroupMemberRole
memRole -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"addMember" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    -- TODO for large groups: no need to load all members to determine if contact is a member
    (Group
group, Contact
contact) <- (Connection -> ExceptT StoreError IO (Group, Contact))
-> CM (Group, Contact)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Group, Contact))
 -> CM (Group, Contact))
-> (Connection -> ExceptT StoreError IO (Group, Contact))
-> CM (Group, Contact)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (Group -> Contact -> (Group, Contact))
-> ExceptT StoreError IO Group
-> ExceptT StoreError IO (Contact -> (Group, Contact))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Group
getGroup Connection
db VersionRangeChat
vr User
user Int64
groupId ExceptT StoreError IO (Contact -> (Group, Contact))
-> ExceptT StoreError IO Contact
-> ExceptT StoreError IO (Group, Contact)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    User
-> MsgDirection
-> Contact
-> CMEventTag 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (e :: MsgEncoding).
User
-> MsgDirection
-> Contact
-> CMEventTag e
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDirectAllowed User
user MsgDirection
MDSnd Contact
contact CMEventTag 'Json
XGrpInv_
    let Group GroupInfo
gInfo [GroupMember]
members = Group
group
        Contact {localDisplayName :: Contact -> Text
localDisplayName = Text
cName} = Contact
contact
    GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo (GroupMemberRole
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupMemberRole -> GroupMemberRole -> GroupMemberRole
forall a. Ord a => a -> a -> a
max GroupMemberRole
GRAdmin GroupMemberRole
memRole
    -- [incognito] forbid to invite contact to whom user is connected incognito
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Contact -> Bool
contactConnIncognito Contact
contact) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEContactIncognitoCantInvite
    -- [incognito] forbid to invite contacts if user joined the group using an incognito profile
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupInfo -> Bool
incognitoMembership GroupInfo
gInfo) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupIncognitoCantInvite
    let sendInvitation :: GroupMember
-> ConnReqInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendInvitation = User
-> Contact
-> GroupInfo
-> GroupMember
-> ConnReqInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendGrpInvitation User
user Contact
contact GroupInfo
gInfo
    case Contact -> [GroupMember] -> Maybe GroupMember
contactMember Contact
contact [GroupMember]
members of
      Maybe GroupMember
Nothing -> do
        TVar ChaChaDRG
gVar <- (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random
        SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
        -- TODO [certs rcv]
        (ByteString
agentConnId, (CCLink ConnReqInvitation
cReq Maybe ShortLinkInvitation
_, Maybe (DBEntityId' 'DBStored)
_serviceId)) <- (AgentClient
 -> ExceptT
      AgentErrorType
      IO
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT
       AgentErrorType
       IO
       (ByteString,
        (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
 -> CM
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> (AgentClient
    -> ExceptT
         AgentErrorType
         IO
         (ByteString,
          (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode 'CMInvitation
-> Maybe (UserConnLinkData 'CMInvitation)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> ExceptT
     AgentErrorType
     IO
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall (c :: ConnectionMode).
ConnectionModeI c =>
AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode c
-> Maybe (UserConnLinkData c)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> AE
     (ByteString, (CreatedConnLink c, Maybe (DBEntityId' 'DBStored)))
createConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) Bool
True Bool
False SConnectionMode 'CMInvitation
SCMInvitation Maybe (UserConnLinkData 'CMInvitation)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing InitialKeys
IKPQOff SubscriptionMode
subMode
        GroupMember
member <- (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> TVar ChaChaDRG
-> User
-> GroupInfo
-> Contact
-> GroupMemberRole
-> ByteString
-> ConnReqInvitation
-> SubscriptionMode
-> ExceptT StoreError IO GroupMember
createNewContactMember Connection
db TVar ChaChaDRG
gVar User
user GroupInfo
gInfo Contact
contact GroupMemberRole
memRole ByteString
agentConnId ConnReqInvitation
cReq SubscriptionMode
subMode
        GroupMember
-> ConnReqInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendInvitation GroupMember
member ConnReqInvitation
cReq
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> Contact -> GroupMember -> ChatResponse
CRSentGroupInvitation User
user GroupInfo
gInfo Contact
contact GroupMember
member
      Just member :: GroupMember
member@GroupMember {Int64
groupMemberId :: Int64
groupMemberId :: GroupMember -> Int64
groupMemberId, GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus :: GroupMember -> GroupMemberStatus
memberStatus, memberRole :: GroupMember -> GroupMemberRole
memberRole = GroupMemberRole
mRole}
        | GroupMemberStatus
memberStatus GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberStatus
GSMemInvited -> do
            Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GroupMemberRole
mRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberRole
memRole) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupMember -> GroupMemberRole -> IO ()
updateGroupMemberRole Connection
db User
user GroupMember
member GroupMemberRole
memRole
            (Connection -> IO (Maybe ConnReqInvitation))
-> CM (Maybe ConnReqInvitation)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection -> User -> Int64 -> IO (Maybe ConnReqInvitation)
getMemberInvitation Connection
db User
user Int64
groupMemberId) CM (Maybe ConnReqInvitation)
-> (Maybe ConnReqInvitation -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just ConnReqInvitation
cReq -> do
                GroupMember
-> ConnReqInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendInvitation GroupMember
member {memberRole = memRole} ConnReqInvitation
cReq
                ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> Contact -> GroupMember -> ChatResponse
CRSentGroupInvitation User
user GroupInfo
gInfo Contact
contact GroupMember
member {memberRole = memRole}
              Maybe ConnReqInvitation
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Text -> ChatErrorType
CEGroupCantResendInvitation GroupInfo
gInfo Text
cName
        | Bool
otherwise -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Text -> ChatErrorType
CEGroupDuplicateMember Text
cName
  APIJoinGroup Int64
groupId MsgFilter
enableNtfs -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"joinGroup" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      (ReceivedGroupInvitation
invitation, Contact
ct) <- (Connection
 -> ExceptT StoreError IO (ReceivedGroupInvitation, Contact))
-> CM (ReceivedGroupInvitation, Contact)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (ReceivedGroupInvitation, Contact))
 -> CM (ReceivedGroupInvitation, Contact))
-> (Connection
    -> ExceptT StoreError IO (ReceivedGroupInvitation, Contact))
-> CM (ReceivedGroupInvitation, Contact)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        inv :: ReceivedGroupInvitation
inv@ReceivedGroupInvitation {GroupMember
fromMember :: GroupMember
fromMember :: ReceivedGroupInvitation -> GroupMember
fromMember} <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation Connection
db VersionRangeChat
vr User
user Int64
groupId
        (ReceivedGroupInvitation
inv,) (Contact -> (ReceivedGroupInvitation, Contact))
-> ExceptT StoreError IO Contact
-> ExceptT StoreError IO (ReceivedGroupInvitation, Contact)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> GroupMember
-> ExceptT StoreError IO Contact
getContactViaMember Connection
db VersionRangeChat
vr User
user GroupMember
fromMember
      let ReceivedGroupInvitation {GroupMember
fromMember :: ReceivedGroupInvitation -> GroupMember
fromMember :: GroupMember
fromMember, ConnReqInvitation
connRequest :: ConnReqInvitation
connRequest :: ReceivedGroupInvitation -> ConnReqInvitation
connRequest, groupInfo :: ReceivedGroupInvitation -> GroupInfo
groupInfo = g :: GroupInfo
g@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership, ChatSettings
chatSettings :: ChatSettings
chatSettings :: GroupInfo -> ChatSettings
chatSettings}} = ReceivedGroupInvitation
invitation
          GroupMember {memberId :: GroupMember -> MemberId
memberId = MemberId
membershipMemId} = GroupMember
membership
          Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} = Contact
ct
      case Maybe Connection
activeConn of
        Just Connection {VersionRangeChat
peerChatVRange :: VersionRangeChat
peerChatVRange :: Connection -> VersionRangeChat
peerChatVRange} -> do
          SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
          ByteString
dm <- ChatMsgEvent 'Json -> CM ByteString
forall (e :: MsgEncoding).
MsgEncodingI e =>
ChatMsgEvent e -> CM ByteString
encodeConnInfo (ChatMsgEvent 'Json -> CM ByteString)
-> ChatMsgEvent 'Json -> CM ByteString
forall a b. (a -> b) -> a -> b
$ MemberId -> ChatMsgEvent 'Json
XGrpAcpt MemberId
membershipMemId
          ByteString
agentConnId <- case GroupMember -> Maybe Connection
memberConn GroupMember
fromMember of
            Maybe Connection
Nothing -> do
              ByteString
agentConnId <- (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ByteString)
 -> CM ByteString)
-> (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> Int64
-> Bool
-> ConnReqInvitation
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
forall (c :: ConnectionMode).
AgentClient
-> Int64
-> Bool
-> ConnectionRequestUri c
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
prepareConnectionToJoin AgentClient
a (User -> Int64
aUserId User
user) Bool
True ConnReqInvitation
connRequest PQSupport
PQSupportOff
              let chatV :: Version ChatVersion
chatV = VersionRangeChat
vr VersionRangeChat -> VersionRangeChat -> Version ChatVersion
`peerConnChatVersion` VersionRangeChat
peerChatVRange
              CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM Connection
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (Connection -> IO Connection) -> CM Connection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Connection) -> CM Connection)
-> (Connection -> IO Connection) -> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64
-> GroupMember
-> ByteString
-> Version ChatVersion
-> VersionRangeChat
-> SubscriptionMode
-> IO Connection
createMemberConnection Connection
db Int64
userId GroupMember
fromMember ByteString
agentConnId Version ChatVersion
chatV VersionRangeChat
peerChatVRange SubscriptionMode
subMode
              ByteString -> CM ByteString
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
agentConnId
            Just Connection
conn -> ByteString -> CM ByteString
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> CM ByteString) -> ByteString -> CM ByteString
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
aConnId Connection
conn
          (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
            Connection -> Int64 -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus Connection
db Int64
userId GroupMember
fromMember GroupMemberStatus
GSMemAccepted
            Connection -> Int64 -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus Connection
db Int64
userId GroupMember
membership GroupMemberStatus
GSMemAccepted
            -- MFAll is default for new groups
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MsgFilter
enableNtfs MsgFilter -> MsgFilter -> Bool
forall a. Eq a => a -> a -> Bool
== MsgFilter
MFAll) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings Connection
db User
user Int64
groupId ChatSettings
chatSettings {enableNtfs}
          ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Bool, Maybe (DBEntityId' 'DBStored))
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((AgentClient
 -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Bool, Maybe (DBEntityId' 'DBStored)))
-> (AgentClient
    -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnReqInvitation
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
forall (c :: ConnectionMode).
AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnectionRequestUri c
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
joinConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) ByteString
agentConnId (MsgFilter
enableNtfs MsgFilter -> MsgFilter -> Bool
forall a. Eq a => a -> a -> Bool
/= MsgFilter
MFNone) ConnReqInvitation
connRequest ByteString
dm PQSupport
PQSupportOff SubscriptionMode
subMode)
            ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
e -> do
              (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
                Connection -> Int64 -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus Connection
db Int64
userId GroupMember
fromMember GroupMemberStatus
GSMemInvited
                Connection -> Int64 -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus Connection
db Int64
userId GroupMember
membership GroupMemberStatus
GSMemInvited
              ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
          User
-> GroupInfo
-> CIGroupInvitationStatus
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateCIGroupInvitationStatus User
user GroupInfo
g CIGroupInvitationStatus
CIGISAccepted ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> Maybe Contact -> ChatResponse
CRUserAcceptedGroupSent User
user GroupInfo
g {membership = membership {memberStatus = GSMemAccepted}} Maybe Contact
forall a. Maybe a
Nothing
        Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
  APIAcceptMember Int64
groupId Int64
gmId GroupMemberRole
role -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    (GroupInfo
gInfo, GroupMember
m) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user Int64
gmId
    -- TODO check that user's role is > role, possibly restrict role to only observer and member
    GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo GroupMemberRole
GRModerator
    case GroupMember -> GroupMemberStatus
memberStatus GroupMember
m of
      GroupMemberStatus
GSMemPendingApproval | GroupMember -> GroupMemberCategory
memberCategory GroupMember
m GroupMemberCategory -> GroupMemberCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberCategory
GCInviteeMember -> do -- only host can approve
        let GroupInfo {groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile {Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission :: GroupProfile -> Maybe GroupMemberAdmission
memberAdmission}} = GroupInfo
gInfo
        case GroupMember -> Maybe Connection
memberConn GroupMember
m of
          Just Connection
mConn ->
            case Maybe GroupMemberAdmission
memberAdmission Maybe GroupMemberAdmission
-> (GroupMemberAdmission -> Maybe MemberCriteria)
-> Maybe MemberCriteria
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GroupMemberAdmission -> Maybe MemberCriteria
review of
              Just MemberCriteria
MCAll -> do
                VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> ExceptT ChatError (ReaderT ChatController IO) ()
introduceToModerators VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
m
                (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus Connection
db Int64
userId GroupMember
m GroupMemberStatus
GSMemPendingReview
                let m' :: GroupMember
m' = GroupMember
m {memberStatus = GSMemPendingReview}
                ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ChatResponse
CRMemberAccepted User
user GroupInfo
gInfo GroupMember
m'
              Maybe MemberCriteria
Nothing -> do
                let msg :: ChatMsgEvent 'Json
msg = GroupAcceptance
-> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json
XGrpLinkAcpt GroupAcceptance
GAAccepted GroupMemberRole
role (GroupMember -> MemberId
memberId' GroupMember
m)
                ExceptT
  ChatError
  (ReaderT ChatController IO)
  (SndMessage, Int64, PQEncryption)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   ChatError
   (ReaderT ChatController IO)
   (SndMessage, Int64, PQEncryption)
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Connection
-> ChatMsgEvent 'Json
-> Int64
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
forall (e :: MsgEncoding).
MsgEncodingI e =>
Connection
-> ChatMsgEvent e
-> Int64
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
sendDirectMemberMessage Connection
mConn ChatMsgEvent 'Json
msg Int64
groupId
                VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> ExceptT ChatError (ReaderT ChatController IO) ()
introduceToRemaining VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
m {memberRole = role}
                Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SGroupFeature 'GFHistory -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureNoRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureAllowed SGroupFeature 'GFHistory
SGFHistory GroupInfo
gInfo) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> GroupMember
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendHistory User
user GroupInfo
gInfo GroupMember
m
                (GroupMember
m', GroupInfo
gInfo') <- (Connection -> IO (GroupMember, GroupInfo))
-> CM (GroupMember, GroupInfo)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (GroupMember, GroupInfo))
 -> CM (GroupMember, GroupInfo))
-> (Connection -> IO (GroupMember, GroupInfo))
-> CM (GroupMember, GroupInfo)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
                  GroupMember
m' <- Connection
-> User
-> GroupMember
-> GroupMemberStatus
-> GroupMemberRole
-> IO GroupMember
updateGroupMemberAccepted Connection
db User
user GroupMember
m GroupMemberStatus
GSMemConnected GroupMemberRole
role
                  GroupInfo
gInfo' <- Connection
-> User -> GroupInfo -> GroupMember -> GroupMember -> IO GroupInfo
updateGroupMembersRequireAttention Connection
db User
user GroupInfo
gInfo GroupMember
m GroupMember
m'
                  (GroupMember, GroupInfo) -> IO (GroupMember, GroupInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember
m', GroupInfo
gInfo')
                -- create item in both scopes
                User
-> ChatDirection 'CTGroup 'MDRcv
-> CIContent 'MDRcv
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo
-> GroupMember
-> ChatDirection 'CTGroup 'MDRcv
CDGroupRcv GroupInfo
gInfo' Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing GroupMember
m') (RcvGroupEvent -> CIContent 'MDRcv
CIRcvGroupEvent RcvGroupEvent
RGEMemberConnected) Maybe UTCTime
forall a. Maybe a
Nothing
                let scopeInfo :: Maybe GroupChatScopeInfo
scopeInfo = GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a. a -> Maybe a
Just GCSIMemberSupport {groupMember_ :: Maybe GroupMember
groupMember_ = GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
m'}
                    gEvent :: SndGroupEvent
gEvent = Int64 -> Profile -> SndGroupEvent
SGEMemberAccepted Int64
gmId (LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> LocalProfile -> Profile
forall a b. (a -> b) -> a -> b
$ GroupMember -> LocalProfile
memberProfile GroupMember
m')
                User
-> ChatDirection 'CTGroup 'MDSnd
-> CIContent 'MDSnd
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo' Maybe GroupChatScopeInfo
scopeInfo) (SndGroupEvent -> CIContent 'MDSnd
CISndGroupEvent SndGroupEvent
gEvent) Maybe UTCTime
forall a. Maybe a
Nothing
                ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ChatResponse
CRMemberAccepted User
user GroupInfo
gInfo' GroupMember
m'
          Maybe Connection
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
      GroupMemberStatus
GSMemPendingReview -> do
        let scope :: Maybe GroupChatScope
scope = GroupChatScope -> Maybe GroupChatScope
forall a. a -> Maybe a
Just (GroupChatScope -> Maybe GroupChatScope)
-> GroupChatScope -> Maybe GroupChatScope
forall a b. (a -> b) -> a -> b
$ Maybe Int64 -> GroupChatScope
GCSMemberSupport (Maybe Int64 -> GroupChatScope) -> Maybe Int64 -> GroupChatScope
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (GroupMember -> Int64
groupMemberId' GroupMember
m)
        [GroupMember]
modMs <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupModerators Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
        let rcpModMs' :: [GroupMember]
rcpModMs' = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrent [GroupMember]
modMs
            msg :: ChatMsgEvent 'Json
msg = GroupAcceptance
-> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json
XGrpLinkAcpt GroupAcceptance
GAAccepted GroupMemberRole
role (GroupMember -> MemberId
memberId' GroupMember
m)
        CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM SndMessage
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent e
-> CM SndMessage
sendGroupMessage User
user GroupInfo
gInfo Maybe GroupChatScope
scope ([Item [GroupMember]
GroupMember
m] [GroupMember] -> [GroupMember] -> [GroupMember]
forall a. Semigroup a => a -> a -> a
<> [GroupMember]
rcpModMs') ChatMsgEvent 'Json
msg
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VersionRangeChat -> Version ChatVersion
forall v. VersionRange v -> Version v
maxVersion (GroupMember -> VersionRangeChat
memberChatVRange GroupMember
m) Version ChatVersion -> Version ChatVersion -> Bool
forall a. Ord a => a -> a -> Bool
< Version ChatVersion
groupKnockingVersion) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
          Maybe Connection
-> (Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (GroupMember -> Maybe Connection
memberConn GroupMember
m) ((Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
mConn -> do
            let msg2 :: ChatMsgEvent 'Json
msg2 = MsgContainer -> ChatMsgEvent 'Json
XMsgNew (MsgContainer -> ChatMsgEvent 'Json)
-> MsgContainer -> ChatMsgEvent 'Json
forall a b. (a -> b) -> a -> b
$ ExtMsgContent -> MsgContainer
MCSimple (ExtMsgContent -> MsgContainer) -> ExtMsgContent -> MsgContainer
forall a b. (a -> b) -> a -> b
$ MsgContent -> Maybe FileInvitation -> ExtMsgContent
extMsgContent (Text -> MsgContent
MCText Text
acceptedToGroupMessage) Maybe FileInvitation
forall a. Maybe a
Nothing
            ExceptT
  ChatError
  (ReaderT ChatController IO)
  (SndMessage, Int64, PQEncryption)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   ChatError
   (ReaderT ChatController IO)
   (SndMessage, Int64, PQEncryption)
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Connection
-> ChatMsgEvent 'Json
-> Int64
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
forall (e :: MsgEncoding).
MsgEncodingI e =>
Connection
-> ChatMsgEvent e
-> Int64
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
sendDirectMemberMessage Connection
mConn ChatMsgEvent 'Json
msg2 Int64
groupId
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMember -> GroupMemberCategory
memberCategory GroupMember
m GroupMemberCategory -> GroupMemberCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberCategory
GCInviteeMember) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
          VersionRangeChat
-> User
-> GroupInfo
-> GroupMember
-> ExceptT ChatError (ReaderT ChatController IO) ()
introduceToRemaining VersionRangeChat
vr User
user GroupInfo
gInfo GroupMember
m {memberRole = role}
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SGroupFeature 'GFHistory -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureNoRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureAllowed SGroupFeature 'GFHistory
SGFHistory GroupInfo
gInfo) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> GroupMember
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendHistory User
user GroupInfo
gInfo GroupMember
m
        (GroupMember
m', GroupInfo
gInfo') <- (Connection -> IO (GroupMember, GroupInfo))
-> CM (GroupMember, GroupInfo)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (GroupMember, GroupInfo))
 -> CM (GroupMember, GroupInfo))
-> (Connection -> IO (GroupMember, GroupInfo))
-> CM (GroupMember, GroupInfo)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          GroupMember
m' <- Connection
-> User
-> GroupMember
-> GroupMemberStatus
-> GroupMemberRole
-> IO GroupMember
updateGroupMemberAccepted Connection
db User
user GroupMember
m GroupMemberStatus
newMemberStatus GroupMemberRole
role
          GroupInfo
gInfo' <- Connection
-> User -> GroupInfo -> GroupMember -> GroupMember -> IO GroupInfo
updateGroupMembersRequireAttention Connection
db User
user GroupInfo
gInfo GroupMember
m GroupMember
m'
          (GroupMember, GroupInfo) -> IO (GroupMember, GroupInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember
m', GroupInfo
gInfo')
        -- create item in both scopes
        User
-> ChatDirection 'CTGroup 'MDRcv
-> CIContent 'MDRcv
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo
-> GroupMember
-> ChatDirection 'CTGroup 'MDRcv
CDGroupRcv GroupInfo
gInfo' Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing GroupMember
m') (RcvGroupEvent -> CIContent 'MDRcv
CIRcvGroupEvent RcvGroupEvent
RGEMemberConnected) Maybe UTCTime
forall a. Maybe a
Nothing
        let scopeInfo :: Maybe GroupChatScopeInfo
scopeInfo = GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a. a -> Maybe a
Just GCSIMemberSupport {groupMember_ :: Maybe GroupMember
groupMember_ = GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
m'}
            gEvent :: SndGroupEvent
gEvent = Int64 -> Profile -> SndGroupEvent
SGEMemberAccepted Int64
gmId (LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> LocalProfile -> Profile
forall a b. (a -> b) -> a -> b
$ GroupMember -> LocalProfile
memberProfile GroupMember
m')
        User
-> ChatDirection 'CTGroup 'MDSnd
-> CIContent 'MDSnd
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> CIContent d
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
createInternalChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo' Maybe GroupChatScopeInfo
scopeInfo) (SndGroupEvent -> CIContent 'MDSnd
CISndGroupEvent SndGroupEvent
gEvent) Maybe UTCTime
forall a. Maybe a
Nothing
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ChatResponse
CRMemberAccepted User
user GroupInfo
gInfo' GroupMember
m'
        where
          newMemberStatus :: GroupMemberStatus
newMemberStatus = case GroupMember -> Maybe Connection
memberConn GroupMember
m of
            Just Connection
c | Connection -> Bool
connReady Connection
c -> GroupMemberStatus
GSMemConnected
            Maybe Connection
_ -> GroupMemberStatus
GSMemAnnounced
      GroupMemberStatus
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"member should be pending approval and invitee, or pending review and not invitee"
  APIDeleteMemberSupportChat Int64
groupId Int64
gmId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
gInfo, GroupMember
m) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMemberById Connection
db VersionRangeChat
vr User
user Int64
gmId
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe GroupSupportChat -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe GroupSupportChat -> Bool) -> Maybe GroupSupportChat -> Bool
forall a b. (a -> b) -> a -> b
$ GroupMember -> Maybe GroupSupportChat
supportChat GroupMember
m) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"member has no support chat"
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMember -> Bool
memberPending GroupMember
m) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"member is pending"
    (GroupInfo
gInfo', GroupMember
m') <- (Connection -> IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      GroupInfo
gInfo' <-
        if GroupMember -> Bool
gmRequiresAttention GroupMember
m
          then Connection -> User -> GroupInfo -> IO GroupInfo
decreaseGroupMembersRequireAttention Connection
db User
user GroupInfo
gInfo
          else GroupInfo -> IO GroupInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupInfo
gInfo
      GroupMember
m' <- Connection -> GroupMember -> IO GroupMember
deleteGroupMemberSupportChat Connection
db GroupMember
m
      (GroupInfo, GroupMember) -> IO (GroupInfo, GroupMember)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
gInfo', GroupMember
m')
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupMember -> ChatResponse
CRMemberSupportChatDeleted User
user GroupInfo
gInfo' GroupMember
m'
  APIMembersRole Int64
groupId NonEmpty Int64
memberIds GroupMemberRole
newRole -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"memberRole" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      -- TODO [channels fwd] possible optimization is to read only required members + relays
      g :: Group
g@(Group GroupInfo
gInfo [GroupMember]
members) <- (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Group) -> CM Group)
-> (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Group
getGroup Connection
db VersionRangeChat
vr User
user Int64
groupId
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupInfo -> Bool
selfSelected GroupInfo
gInfo) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"can't change role for self"
      let ([GroupMember]
invitedMems, [GroupMember]
currentMems, [GroupMember]
unchangedMems, GroupMemberRole
maxRole, Bool
anyAdmin, Bool
anyPending) = [GroupMember]
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
selectMembers [GroupMember]
members
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GroupMember] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMember]
invitedMems Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GroupMember] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMember]
currentMems Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [GroupMember] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMember]
unchangedMems Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty Int64 -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Int64
memberIds) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotFound
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty Int64 -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Int64
memberIds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& (Bool
anyAdmin Bool -> Bool -> Bool
|| GroupMemberRole
newRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
>= GroupMemberRole
GRAdmin)) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
        String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"can't change role of multiple members when admins selected, or new role is admin"
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
anyPending (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"can't change role of members pending approval"
      GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo (GroupMemberRole
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [GroupMemberRole] -> GroupMemberRole
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Item [GroupMemberRole]
GroupMemberRole
GRAdmin, Item [GroupMemberRole]
GroupMemberRole
maxRole, Item [GroupMemberRole]
GroupMemberRole
newRole] :: [GroupMemberRole])
      ([ChatError]
errs1, [GroupMember]
changed1) <- User
-> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
changeRoleInvitedMems User
user GroupInfo
gInfo [GroupMember]
invitedMems
      ([ChatError]
errs2, [GroupMember]
changed2, [AChatItem]
acis) <- User
-> Group
-> [GroupMember]
-> CM ([ChatError], [GroupMember], [AChatItem])
changeRoleCurrentMems User
user Group
g [GroupMember]
currentMems
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AChatItem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AChatItem]
acis) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [AChatItem]
acis
      let errs :: [ChatError]
errs = [ChatError]
errs1 [ChatError] -> [ChatError] -> [ChatError]
forall a. Semigroup a => a -> a -> a
<> [ChatError]
errs2
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ CRMembersRoleUser {User
user :: User
user :: User
user, groupInfo :: GroupInfo
groupInfo = GroupInfo
gInfo, members :: [GroupMember]
members = [GroupMember]
changed1 [GroupMember] -> [GroupMember] -> [GroupMember]
forall a. Semigroup a => a -> a -> a
<> [GroupMember]
changed2, toRole :: GroupMemberRole
toRole = GroupMemberRole
newRole} -- same order is not guaranteed
    where
      selfSelected :: GroupInfo -> Bool
selfSelected GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} = Int64 -> NonEmpty Int64 -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (GroupMember -> Int64
groupMemberId' GroupMember
membership) NonEmpty Int64
memberIds
      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
      selectMembers :: [GroupMember]
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
selectMembers = (GroupMember
 -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
     Bool, Bool)
 -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
     Bool, Bool))
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
-> [GroupMember]
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' GroupMember
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
addMember ([], [], [], GroupMemberRole
GRObserver, Bool
False, Bool
False)
        where
          addMember :: GroupMember
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
-> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole,
    Bool, Bool)
addMember m :: GroupMember
m@GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, GroupMemberStatus
memberStatus :: GroupMember -> GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus, GroupMemberRole
memberRole :: GroupMember -> GroupMemberRole
memberRole :: GroupMemberRole
memberRole} ([GroupMember]
invited, [GroupMember]
current, [GroupMember]
unchanged, GroupMemberRole
maxRole, Bool
anyAdmin, Bool
anyPending)
            | Int64
groupMemberId Int64 -> NonEmpty Int64 -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` NonEmpty Int64
memberIds =
                let maxRole' :: GroupMemberRole
maxRole' = GroupMemberRole -> GroupMemberRole -> GroupMemberRole
forall a. Ord a => a -> a -> a
max GroupMemberRole
maxRole GroupMemberRole
memberRole
                    anyAdmin' :: Bool
anyAdmin' = Bool
anyAdmin Bool -> Bool -> Bool
|| GroupMemberRole
memberRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
>= GroupMemberRole
GRAdmin
                    anyPending' :: Bool
anyPending' = Bool
anyPending Bool -> Bool -> Bool
|| GroupMember -> Bool
memberPending GroupMember
m
                 in
                  if
                    | GroupMemberRole
memberRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberRole
newRole -> ([GroupMember]
invited, [GroupMember]
current, GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
unchanged, GroupMemberRole
maxRole', Bool
anyAdmin', Bool
anyPending')
                    | GroupMemberStatus
memberStatus GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberStatus
GSMemInvited -> (GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
invited, [GroupMember]
current, [GroupMember]
unchanged, GroupMemberRole
maxRole', Bool
anyAdmin', Bool
anyPending')
                    | Bool
otherwise -> ([GroupMember]
invited, GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
current, [GroupMember]
unchanged, GroupMemberRole
maxRole', Bool
anyAdmin', Bool
anyPending')
            | Bool
otherwise = ([GroupMember]
invited, [GroupMember]
current, [GroupMember]
unchanged, GroupMemberRole
maxRole, Bool
anyAdmin, Bool
anyPending)
      changeRoleInvitedMems :: User -> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
      changeRoleInvitedMems :: User
-> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
changeRoleInvitedMems User
user GroupInfo
gInfo [GroupMember]
memsToChange = do
        -- not batched, as we need to send different invitations to different connections anyway
        [Either ChatError GroupMember]
mems_ <- [GroupMember]
-> (GroupMember
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Either ChatError GroupMember))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [Either ChatError GroupMember]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [GroupMember]
memsToChange ((GroupMember
  -> ExceptT
       ChatError
       (ReaderT ChatController IO)
       (Either ChatError GroupMember))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      [Either ChatError GroupMember])
-> (GroupMember
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Either ChatError GroupMember))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [Either ChatError GroupMember]
forall a b. (a -> b) -> a -> b
$ \GroupMember
m -> (GroupMember -> Either ChatError GroupMember
forall a b. b -> Either a b
Right (GroupMember -> Either ChatError GroupMember)
-> CM GroupMember
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Either ChatError GroupMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupMember -> CM GroupMember
changeRole GroupMember
m) ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Either ChatError GroupMember)
-> (ChatError
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Either ChatError GroupMember))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Either ChatError GroupMember)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` (Either ChatError GroupMember
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Either ChatError GroupMember)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ChatError GroupMember
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Either ChatError GroupMember))
-> (ChatError -> Either ChatError GroupMember)
-> ChatError
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Either ChatError GroupMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatError -> Either ChatError GroupMember
forall a b. a -> Either a b
Left)
        ([ChatError], [GroupMember]) -> CM ([ChatError], [GroupMember])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([ChatError], [GroupMember]) -> CM ([ChatError], [GroupMember]))
-> ([ChatError], [GroupMember]) -> CM ([ChatError], [GroupMember])
forall a b. (a -> b) -> a -> b
$ [Either ChatError GroupMember] -> ([ChatError], [GroupMember])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ChatError GroupMember]
mems_
        where
          changeRole :: GroupMember -> CM GroupMember
          changeRole :: GroupMember -> CM GroupMember
changeRole m :: GroupMember
m@GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, Maybe Int64
memberContactId :: GroupMember -> Maybe Int64
memberContactId :: Maybe Int64
memberContactId, localDisplayName :: GroupMember -> Text
localDisplayName = Text
cName} = do
            (Connection
 -> ExceptT StoreError IO (Maybe Contact, Maybe ConnReqInvitation))
-> CM (Maybe Contact, Maybe ConnReqInvitation)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> (,) (Maybe Contact
 -> Maybe ConnReqInvitation
 -> (Maybe Contact, Maybe ConnReqInvitation))
-> ExceptT StoreError IO (Maybe Contact)
-> ExceptT
     StoreError
     IO
     (Maybe ConnReqInvitation
      -> (Maybe Contact, Maybe ConnReqInvitation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int64 -> ExceptT StoreError IO Contact)
-> Maybe Int64 -> ExceptT StoreError IO (Maybe Contact)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user) Maybe Int64
memberContactId ExceptT
  StoreError
  IO
  (Maybe ConnReqInvitation
   -> (Maybe Contact, Maybe ConnReqInvitation))
-> ExceptT StoreError IO (Maybe ConnReqInvitation)
-> ExceptT StoreError IO (Maybe Contact, Maybe ConnReqInvitation)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Maybe ConnReqInvitation)
-> ExceptT StoreError IO (Maybe ConnReqInvitation)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> User -> Int64 -> IO (Maybe ConnReqInvitation)
getMemberInvitation Connection
db User
user Int64
groupMemberId)) CM (Maybe Contact, Maybe ConnReqInvitation)
-> ((Maybe Contact, Maybe ConnReqInvitation) -> CM GroupMember)
-> CM GroupMember
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              (Just Contact
ct, Just ConnReqInvitation
cReq) -> do
                User
-> Contact
-> GroupInfo
-> GroupMember
-> ConnReqInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendGrpInvitation User
user Contact
ct GroupInfo
gInfo (GroupMember
m :: GroupMember) {memberRole = newRole} ConnReqInvitation
cReq
                (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupMember -> GroupMemberRole -> IO ()
updateGroupMemberRole Connection
db User
user GroupMember
m GroupMemberRole
newRole
                GroupMember -> CM GroupMember
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember
m :: GroupMember) {memberRole = newRole}
              (Maybe Contact, Maybe ConnReqInvitation)
_ -> ChatErrorType -> CM GroupMember
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM GroupMember)
-> ChatErrorType -> CM GroupMember
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Text -> ChatErrorType
CEGroupCantResendInvitation GroupInfo
gInfo Text
cName
      changeRoleCurrentMems :: User -> Group -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
      changeRoleCurrentMems :: User
-> Group
-> [GroupMember]
-> CM ([ChatError], [GroupMember], [AChatItem])
changeRoleCurrentMems User
user (Group GroupInfo
gInfo [GroupMember]
members) [GroupMember]
memsToChange = case [GroupMember] -> Maybe (NonEmpty GroupMember)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [GroupMember]
memsToChange of
        Maybe (NonEmpty GroupMember)
Nothing -> ([ChatError], [GroupMember], [AChatItem])
-> CM ([ChatError], [GroupMember], [AChatItem])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], [])
        Just NonEmpty GroupMember
memsToChange' -> do
          let events :: NonEmpty (ChatMsgEvent 'Json)
events = (GroupMember -> ChatMsgEvent 'Json)
-> NonEmpty GroupMember -> NonEmpty (ChatMsgEvent 'Json)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map (\GroupMember {MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId} -> MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
XGrpMemRole MemberId
memberId GroupMemberRole
newRole) NonEmpty GroupMember
memsToChange'
              recipients :: [GroupMember]
recipients = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrent [GroupMember]
members
          (NonEmpty (Either ChatError SndMessage)
msgs_, GroupSndResult
_gsr) <- User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages User
user GroupInfo
gInfo Maybe GroupChatScope
forall a. Maybe a
Nothing [GroupMember]
recipients NonEmpty (ChatMsgEvent 'Json)
events
          let itemsData :: [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData = (GroupMember
 -> Either ChatError SndMessage
 -> Either ChatError (NewSndChatItemData 'CTGroup))
-> [GroupMember]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((SndMessage -> NewSndChatItemData 'CTGroup)
-> Either ChatError SndMessage
-> Either ChatError (NewSndChatItemData 'CTGroup)
forall a b. (a -> b) -> Either ChatError a -> Either ChatError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SndMessage -> NewSndChatItemData 'CTGroup)
 -> Either ChatError SndMessage
 -> Either ChatError (NewSndChatItemData 'CTGroup))
-> (GroupMember -> SndMessage -> NewSndChatItemData 'CTGroup)
-> GroupMember
-> Either ChatError SndMessage
-> Either ChatError (NewSndChatItemData 'CTGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupMember -> SndMessage -> NewSndChatItemData 'CTGroup
forall (c :: ChatType).
GroupMember -> SndMessage -> NewSndChatItemData c
sndItemData) [GroupMember]
memsToChange (NonEmpty (Either ChatError SndMessage)
-> [Either ChatError SndMessage]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Either ChatError SndMessage)
msgs_)
          [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ <- User
-> ChatDirection 'CTGroup 'MDSnd
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> [Either ChatError (NewSndChatItemData c)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem c 'MDSnd)]
saveSndChatItems User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing) [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData Maybe CITimed
forall a. Maybe a
Nothing Bool
False
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Either ChatError (ChatItem 'CTGroup 'MDSnd)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [GroupMember] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMember]
memsToChange) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logError Text
"changeRoleCurrentMems: memsToChange and cis_ length mismatch"
          ([ChatError]
errs, [GroupMember]
changed) <- ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [GroupMember])
 -> CM ([ChatError], [GroupMember]))
-> ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall a b. (a -> b) -> a -> b
$ [Either ChatError GroupMember] -> ([ChatError], [GroupMember])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError GroupMember] -> ([ChatError], [GroupMember]))
-> ReaderT ChatController IO [Either ChatError GroupMember]
-> ReaderT ChatController IO ([ChatError], [GroupMember])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO GroupMember])
-> ReaderT ChatController IO [Either ChatError GroupMember]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO a)) -> CM' (t (Either ChatError a))
withStoreBatch' (\Connection
db -> (GroupMember -> IO GroupMember)
-> [GroupMember] -> [IO GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (Connection -> GroupMember -> IO GroupMember
updMember Connection
db) [GroupMember]
memsToChange)
          let acis :: [AChatItem]
acis = (ChatItem 'CTGroup 'MDSnd -> AChatItem)
-> [ChatItem 'CTGroup 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map (SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing)) ([ChatItem 'CTGroup 'MDSnd] -> [AChatItem])
-> [ChatItem 'CTGroup 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> a -> b
$ [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> [ChatItem 'CTGroup 'MDSnd]
forall a b. [Either a b] -> [b]
rights [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_
          ([ChatError], [GroupMember], [AChatItem])
-> CM ([ChatError], [GroupMember], [AChatItem])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ChatError]
errs, [GroupMember]
changed, [AChatItem]
acis)
          where
            sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
            sndItemData :: forall (c :: ChatType).
GroupMember -> SndMessage -> NewSndChatItemData c
sndItemData GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, LocalProfile
memberProfile :: GroupMember -> LocalProfile
memberProfile :: LocalProfile
memberProfile} SndMessage
msg =
              let content :: CIContent 'MDSnd
content = SndGroupEvent -> CIContent 'MDSnd
CISndGroupEvent (SndGroupEvent -> CIContent 'MDSnd)
-> SndGroupEvent -> CIContent 'MDSnd
forall a b. (a -> b) -> a -> b
$ Int64 -> Profile -> GroupMemberRole -> SndGroupEvent
SGEMemberRole Int64
groupMemberId (LocalProfile -> Profile
fromLocalProfile LocalProfile
memberProfile) GroupMemberRole
newRole
                  ts :: (Text, Maybe MarkdownList)
ts = CIContent 'MDSnd -> (Text, Maybe MarkdownList)
forall (d :: MsgDirection).
CIContent d -> (Text, Maybe MarkdownList)
ciContentTexts CIContent 'MDSnd
content
               in SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
forall (c :: ChatType).
SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
NewSndChatItemData SndMessage
msg CIContent 'MDSnd
content (Text, Maybe MarkdownList)
ts Map Text CIMention
forall k a. Map k a
M.empty Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing Maybe (CIQuote c)
forall a. Maybe a
Nothing Maybe CIForwardedFrom
forall a. Maybe a
Nothing
            updMember :: Connection -> GroupMember -> IO GroupMember
updMember Connection
db GroupMember
m = do
              Connection -> User -> GroupMember -> GroupMemberRole -> IO ()
updateGroupMemberRole Connection
db User
user GroupMember
m GroupMemberRole
newRole
              GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupMember
m :: GroupMember) {memberRole = newRole}
  APIBlockMembersForAll Int64
groupId NonEmpty Int64
memberIds Bool
blockFlag -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"blockForAll" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      -- TODO [channels fwd] possible optimization is to read only required members + relays
      Group GroupInfo
gInfo [GroupMember]
members <- (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Group) -> CM Group)
-> (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Group
getGroup Connection
db VersionRangeChat
vr User
user Int64
groupId
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupInfo -> Bool
selfSelected GroupInfo
gInfo) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"can't block/unblock self"
      -- TODO [channels fwd] consider sending restriction to all members (remove filtering), as we do in delivery jobs
      let ([GroupMember]
blockMems, [GroupMember]
remainingMems, GroupMemberRole
maxRole, Bool
anyAdmin, Bool
anyPending) = [GroupMember]
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
selectMembers [GroupMember]
members
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([GroupMember] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMember]
blockMems Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty Int64 -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Int64
memberIds) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotFound
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty Int64 -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Int64
memberIds Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool
anyAdmin) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"can't block/unblock multiple members when admins selected"
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
anyPending (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"can't block/unblock members pending approval"
      GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo (GroupMemberRole
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupMemberRole -> GroupMemberRole -> GroupMemberRole
forall a. Ord a => a -> a -> a
max GroupMemberRole
GRModerator GroupMemberRole
maxRole
      User
-> GroupInfo -> [GroupMember] -> [GroupMember] -> CM ChatResponse
blockMembers User
user GroupInfo
gInfo [GroupMember]
blockMems [GroupMember]
remainingMems
    where
      selfSelected :: GroupInfo -> Bool
selfSelected GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} = Int64 -> NonEmpty Int64 -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (GroupMember -> Int64
groupMemberId' GroupMember
membership) NonEmpty Int64
memberIds
      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
      selectMembers :: [GroupMember]
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
selectMembers = (GroupMember
 -> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
 -> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool))
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
-> [GroupMember]
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' GroupMember
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
addMember ([], [], GroupMemberRole
GRObserver, Bool
False, Bool
False)
        where
          addMember :: GroupMember
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
-> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
addMember m :: GroupMember
m@GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, GroupMemberRole
memberRole :: GroupMember -> GroupMemberRole
memberRole :: GroupMemberRole
memberRole} ([GroupMember]
block, [GroupMember]
remaining, GroupMemberRole
maxRole, Bool
anyAdmin, Bool
anyPending)
            | Int64
groupMemberId Int64 -> NonEmpty Int64 -> Bool
forall a. Eq a => a -> NonEmpty a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` NonEmpty Int64
memberIds =
                let maxRole' :: GroupMemberRole
maxRole' = GroupMemberRole -> GroupMemberRole -> GroupMemberRole
forall a. Ord a => a -> a -> a
max GroupMemberRole
maxRole GroupMemberRole
memberRole
                    anyAdmin' :: Bool
anyAdmin' = Bool
anyAdmin Bool -> Bool -> Bool
|| GroupMemberRole
memberRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
>= GroupMemberRole
GRAdmin
                    anyPending' :: Bool
anyPending' = Bool
anyPending Bool -> Bool -> Bool
|| GroupMember -> Bool
memberPending GroupMember
m
                 in (GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
block, [GroupMember]
remaining, GroupMemberRole
maxRole', Bool
anyAdmin', Bool
anyPending')
            | Bool
otherwise = ([GroupMember]
block, GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
remaining, GroupMemberRole
maxRole, Bool
anyAdmin, Bool
anyPending)
      blockMembers :: User -> GroupInfo -> [GroupMember] -> [GroupMember] -> CM ChatResponse
      blockMembers :: User
-> GroupInfo -> [GroupMember] -> [GroupMember] -> CM ChatResponse
blockMembers User
user GroupInfo
gInfo [GroupMember]
blockMems [GroupMember]
remainingMems = case [GroupMember] -> Maybe (NonEmpty GroupMember)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [GroupMember]
blockMems of
        Maybe (NonEmpty GroupMember)
Nothing -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"no members to block/unblock"
        Just NonEmpty GroupMember
blockMems' -> do
          let mrs :: MemberRestrictionStatus
mrs = if Bool
blockFlag then MemberRestrictionStatus
MRSBlocked else MemberRestrictionStatus
MRSUnrestricted
              events :: NonEmpty (ChatMsgEvent 'Json)
events = (GroupMember -> ChatMsgEvent 'Json)
-> NonEmpty GroupMember -> NonEmpty (ChatMsgEvent 'Json)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map (\GroupMember {MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId} -> MemberId -> MemberRestrictions -> ChatMsgEvent 'Json
XGrpMemRestrict MemberId
memberId MemberRestrictions {restriction :: MemberRestrictionStatus
restriction = MemberRestrictionStatus
mrs}) NonEmpty GroupMember
blockMems'
              recipients :: [GroupMember]
recipients = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrent [GroupMember]
remainingMems
          (NonEmpty (Either ChatError SndMessage)
msgs_, GroupSndResult
_gsr) <- User
-> GroupInfo
-> [GroupMember]
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> [GroupMember]
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages_ User
user GroupInfo
gInfo [GroupMember]
recipients NonEmpty (ChatMsgEvent 'Json)
events
          let itemsData :: [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData = (GroupMember
 -> Either ChatError SndMessage
 -> Either ChatError (NewSndChatItemData 'CTGroup))
-> [GroupMember]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((SndMessage -> NewSndChatItemData 'CTGroup)
-> Either ChatError SndMessage
-> Either ChatError (NewSndChatItemData 'CTGroup)
forall a b. (a -> b) -> Either ChatError a -> Either ChatError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SndMessage -> NewSndChatItemData 'CTGroup)
 -> Either ChatError SndMessage
 -> Either ChatError (NewSndChatItemData 'CTGroup))
-> (GroupMember -> SndMessage -> NewSndChatItemData 'CTGroup)
-> GroupMember
-> Either ChatError SndMessage
-> Either ChatError (NewSndChatItemData 'CTGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupMember -> SndMessage -> NewSndChatItemData 'CTGroup
forall (c :: ChatType).
GroupMember -> SndMessage -> NewSndChatItemData c
sndItemData) [GroupMember]
blockMems (NonEmpty (Either ChatError SndMessage)
-> [Either ChatError SndMessage]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Either ChatError SndMessage)
msgs_)
          [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ <- User
-> ChatDirection 'CTGroup 'MDSnd
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> [Either ChatError (NewSndChatItemData c)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem c 'MDSnd)]
saveSndChatItems User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing) [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData Maybe CITimed
forall a. Maybe a
Nothing Bool
False
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Either ChatError (ChatItem 'CTGroup 'MDSnd)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [GroupMember] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMember]
blockMems) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logError Text
"blockMembers: blockMems and cis_ length mismatch"
          let acis :: [AChatItem]
acis = (ChatItem 'CTGroup 'MDSnd -> AChatItem)
-> [ChatItem 'CTGroup 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map (SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing)) ([ChatItem 'CTGroup 'MDSnd] -> [AChatItem])
-> [ChatItem 'CTGroup 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> a -> b
$ [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> [ChatItem 'CTGroup 'MDSnd]
forall a b. [Either a b] -> [b]
rights [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AChatItem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AChatItem]
acis) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [AChatItem]
acis
          ([ChatError]
errs, [GroupMember]
blocked) <- ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [GroupMember])
 -> CM ([ChatError], [GroupMember]))
-> ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall a b. (a -> b) -> a -> b
$ [Either ChatError GroupMember] -> ([ChatError], [GroupMember])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError GroupMember] -> ([ChatError], [GroupMember]))
-> ReaderT ChatController IO [Either ChatError GroupMember]
-> ReaderT ChatController IO ([ChatError], [GroupMember])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO GroupMember])
-> ReaderT ChatController IO [Either ChatError GroupMember]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO a)) -> CM' (t (Either ChatError a))
withStoreBatch' (\Connection
db -> (GroupMember -> IO GroupMember)
-> [GroupMember] -> [IO GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (Connection
-> User
-> GroupInfo
-> MemberRestrictionStatus
-> GroupMember
-> IO GroupMember
updateGroupMemberBlocked Connection
db User
user GroupInfo
gInfo MemberRestrictionStatus
mrs) [GroupMember]
blockMems)
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
          -- TODO not batched - requires agent batch api
          [GroupMember]
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMember]
blocked ((GroupMember -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \GroupMember
m -> GroupMember
-> Bool -> ExceptT ChatError (ReaderT ChatController IO) ()
toggleNtf GroupMember
m (Bool -> Bool
not Bool
blockFlag)
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRMembersBlockedForAllUser {User
user :: User
user :: User
user, groupInfo :: GroupInfo
groupInfo = GroupInfo
gInfo, members :: [GroupMember]
members = [GroupMember]
blocked, blocked :: Bool
blocked = Bool
blockFlag}
        where
          sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c
          sndItemData :: forall (c :: ChatType).
GroupMember -> SndMessage -> NewSndChatItemData c
sndItemData GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, LocalProfile
memberProfile :: GroupMember -> LocalProfile
memberProfile :: LocalProfile
memberProfile} SndMessage
msg =
            let content :: CIContent 'MDSnd
content = SndGroupEvent -> CIContent 'MDSnd
CISndGroupEvent (SndGroupEvent -> CIContent 'MDSnd)
-> SndGroupEvent -> CIContent 'MDSnd
forall a b. (a -> b) -> a -> b
$ Int64 -> Profile -> Bool -> SndGroupEvent
SGEMemberBlocked Int64
groupMemberId (LocalProfile -> Profile
fromLocalProfile LocalProfile
memberProfile) Bool
blockFlag
                ts :: (Text, Maybe MarkdownList)
ts = CIContent 'MDSnd -> (Text, Maybe MarkdownList)
forall (d :: MsgDirection).
CIContent d -> (Text, Maybe MarkdownList)
ciContentTexts CIContent 'MDSnd
content
             in SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
forall (c :: ChatType).
SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
NewSndChatItemData SndMessage
msg CIContent 'MDSnd
content (Text, Maybe MarkdownList)
ts Map Text CIMention
forall k a. Map k a
M.empty Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing Maybe (CIQuote c)
forall a. Maybe a
Nothing Maybe CIForwardedFrom
forall a. Maybe a
Nothing
  APIRemoveMembers {Int64
groupId :: Int64
groupId :: ChatCommand -> Int64
groupId, NonEmpty Int64
groupMemberIds :: NonEmpty Int64
groupMemberIds :: ChatCommand -> NonEmpty Int64
groupMemberIds, Bool
withMessages :: Bool
withMessages :: ChatCommand -> Bool
withMessages} -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"removeMembers" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      -- TODO [channels fwd] possible optimization is to read only required members + relays
      Group GroupInfo
gInfo [GroupMember]
members <- (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Group) -> CM Group)
-> (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Group
getGroup Connection
db VersionRangeChat
vr User
user Int64
groupId
      let (Int
count, [GroupMember]
invitedMems, [GroupMember]
pendingApprvMems, [GroupMember]
pendingRvwMems, [GroupMember]
currentMems, GroupMemberRole
maxRole, Bool
anyAdmin) = Set Int64
-> [GroupMember]
-> (Int, [GroupMember], [GroupMember], [GroupMember],
    [GroupMember], GroupMemberRole, Bool)
selectMembers Set Int64
gmIds [GroupMember]
members
          gmIds :: Set Int64
gmIds = [Int64] -> Set Int64
forall a. Ord a => [a] -> Set a
S.fromList ([Int64] -> Set Int64) -> [Int64] -> Set Int64
forall a b. (a -> b) -> a -> b
$ NonEmpty Int64 -> [Int64]
forall a. NonEmpty a -> [a]
L.toList NonEmpty Int64
groupMemberIds
          memCount :: Int
memCount = NonEmpty Int64 -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Int64
groupMemberIds
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
memCount) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotFound
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
memCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool
anyAdmin) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"can't remove multiple members when admins selected"
      GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo (GroupMemberRole
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupMemberRole -> GroupMemberRole -> GroupMemberRole
forall a. Ord a => a -> a -> a
max GroupMemberRole
GRAdmin GroupMemberRole
maxRole
      ([ChatError]
errs1, [GroupMember]
deleted1) <- User -> [GroupMember] -> CM ([ChatError], [GroupMember])
deleteInvitedMems User
user [GroupMember]
invitedMems
      let recipients :: [GroupMember]
recipients = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrent [GroupMember]
members
      ([ChatError]
errs2, [GroupMember]
deleted2, [AChatItem]
acis2) <- User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> [GroupMember]
-> CM ([ChatError], [GroupMember], [AChatItem])
deleteMemsSend User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing [GroupMember]
recipients [GroupMember]
currentMems
      ([ChatError]
errs3, [GroupMember]
deleted3, [AChatItem]
acis3) <-
        (([ChatError], [GroupMember], [AChatItem])
 -> GroupMember -> CM ([ChatError], [GroupMember], [AChatItem]))
-> ([ChatError], [GroupMember], [AChatItem])
-> [GroupMember]
-> CM ([ChatError], [GroupMember], [AChatItem])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\([ChatError], [GroupMember], [AChatItem])
acc GroupMember
m -> ([ChatError], [GroupMember], [AChatItem])
-> User
-> GroupInfo
-> [GroupMember]
-> GroupMember
-> CM ([ChatError], [GroupMember], [AChatItem])
deletePendingMember ([ChatError], [GroupMember], [AChatItem])
acc User
user GroupInfo
gInfo [Item [GroupMember]
GroupMember
m] GroupMember
m) ([], [], []) [GroupMember]
pendingApprvMems
      let moderators :: [GroupMember]
moderators = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter (\GroupMember {GroupMemberRole
memberRole :: GroupMember -> GroupMemberRole
memberRole :: GroupMemberRole
memberRole} -> GroupMemberRole
memberRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
>= GroupMemberRole
GRModerator) [GroupMember]
members
      ([ChatError]
errs4, [GroupMember]
deleted4, [AChatItem]
acis4) <-
        (([ChatError], [GroupMember], [AChatItem])
 -> GroupMember -> CM ([ChatError], [GroupMember], [AChatItem]))
-> ([ChatError], [GroupMember], [AChatItem])
-> [GroupMember]
-> CM ([ChatError], [GroupMember], [AChatItem])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\([ChatError], [GroupMember], [AChatItem])
acc GroupMember
m -> ([ChatError], [GroupMember], [AChatItem])
-> User
-> GroupInfo
-> [GroupMember]
-> GroupMember
-> CM ([ChatError], [GroupMember], [AChatItem])
deletePendingMember ([ChatError], [GroupMember], [AChatItem])
acc User
user GroupInfo
gInfo (GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
moderators) GroupMember
m) ([], [], []) [GroupMember]
pendingRvwMems
      let acis :: [AChatItem]
acis = [AChatItem]
acis2 [AChatItem] -> [AChatItem] -> [AChatItem]
forall a. Semigroup a => a -> a -> a
<> [AChatItem]
acis3 [AChatItem] -> [AChatItem] -> [AChatItem]
forall a. Semigroup a => a -> a -> a
<> [AChatItem]
acis4
          errs :: [ChatError]
errs = [ChatError]
errs1 [ChatError] -> [ChatError] -> [ChatError]
forall a. Semigroup a => a -> a -> a
<> [ChatError]
errs2 [ChatError] -> [ChatError] -> [ChatError]
forall a. Semigroup a => a -> a -> a
<> [ChatError]
errs3 [ChatError] -> [ChatError] -> [ChatError]
forall a. Semigroup a => a -> a -> a
<> [ChatError]
errs4
          deleted :: [GroupMember]
deleted = [GroupMember]
deleted1 [GroupMember] -> [GroupMember] -> [GroupMember]
forall a. Semigroup a => a -> a -> a
<> [GroupMember]
deleted2 [GroupMember] -> [GroupMember] -> [GroupMember]
forall a. Semigroup a => a -> a -> a
<> [GroupMember]
deleted3 [GroupMember] -> [GroupMember] -> [GroupMember]
forall a. Semigroup a => a -> a -> a
<> [GroupMember]
deleted4
      -- Read group info with updated membersRequireAttention
      GroupInfo
gInfo' <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
      let acis' :: [AChatItem]
acis' = (AChatItem -> AChatItem) -> [AChatItem] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map (GroupInfo -> AChatItem -> AChatItem
updateACIGroupInfo GroupInfo
gInfo') [AChatItem]
acis
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AChatItem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AChatItem]
acis') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [AChatItem]
acis'
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withMessages (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> [GroupMember]
-> ExceptT ChatError (ReaderT ChatController IO) ()
deleteMessages User
user GroupInfo
gInfo' [GroupMember]
deleted
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> [GroupMember] -> Bool -> ChatResponse
CRUserDeletedMembers User
user GroupInfo
gInfo' [GroupMember]
deleted Bool
withMessages -- same order is not guaranteed
    where
      selectMembers :: S.Set GroupMemberId -> [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
      selectMembers :: Set Int64
-> [GroupMember]
-> (Int, [GroupMember], [GroupMember], [GroupMember],
    [GroupMember], GroupMemberRole, Bool)
selectMembers Set Int64
gmIds = ((Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember],
  GroupMemberRole, Bool)
 -> GroupMember
 -> (Int, [GroupMember], [GroupMember], [GroupMember],
     [GroupMember], GroupMemberRole, Bool))
-> (Int, [GroupMember], [GroupMember], [GroupMember],
    [GroupMember], GroupMemberRole, Bool)
-> [GroupMember]
-> (Int, [GroupMember], [GroupMember], [GroupMember],
    [GroupMember], GroupMemberRole, Bool)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember],
 GroupMemberRole, Bool)
-> GroupMember
-> (Int, [GroupMember], [GroupMember], [GroupMember],
    [GroupMember], GroupMemberRole, Bool)
addMember (Int
0, [], [], [], [], GroupMemberRole
GRObserver, Bool
False)
        where
          addMember :: (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember],
 GroupMemberRole, Bool)
-> GroupMember
-> (Int, [GroupMember], [GroupMember], [GroupMember],
    [GroupMember], GroupMemberRole, Bool)
addMember acc :: (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember],
 GroupMemberRole, Bool)
acc@(Int
n, [GroupMember]
invited, [GroupMember]
pendingApprv, [GroupMember]
pendingRvw, [GroupMember]
current, GroupMemberRole
maxRole, Bool
anyAdmin) m :: GroupMember
m@GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, GroupMemberStatus
memberStatus :: GroupMember -> GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus, GroupMemberRole
memberRole :: GroupMember -> GroupMemberRole
memberRole :: GroupMemberRole
memberRole}
            | Int64
groupMemberId Int64 -> Set Int64 -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int64
gmIds =
                let maxRole' :: GroupMemberRole
maxRole' = GroupMemberRole -> GroupMemberRole -> GroupMemberRole
forall a. Ord a => a -> a -> a
max GroupMemberRole
maxRole GroupMemberRole
memberRole
                    anyAdmin' :: Bool
anyAdmin' = Bool
anyAdmin Bool -> Bool -> Bool
|| GroupMemberRole
memberRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
>= GroupMemberRole
GRAdmin
                    n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                 in case GroupMemberStatus
memberStatus of
                      GroupMemberStatus
GSMemInvited -> (Int
n', GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
invited, [GroupMember]
pendingApprv, [GroupMember]
pendingRvw, [GroupMember]
current, GroupMemberRole
maxRole', Bool
anyAdmin')
                      GroupMemberStatus
GSMemPendingApproval -> (Int
n', [GroupMember]
invited, GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
pendingApprv, [GroupMember]
pendingRvw, [GroupMember]
current, GroupMemberRole
maxRole', Bool
anyAdmin')
                      GroupMemberStatus
GSMemPendingReview -> (Int
n', [GroupMember]
invited, [GroupMember]
pendingApprv, GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
pendingRvw, [GroupMember]
current, GroupMemberRole
maxRole', Bool
anyAdmin')
                      GroupMemberStatus
_ -> (Int
n', [GroupMember]
invited, [GroupMember]
pendingApprv, [GroupMember]
pendingRvw, GroupMember
m GroupMember -> [GroupMember] -> [GroupMember]
forall a. a -> [a] -> [a]
: [GroupMember]
current, GroupMemberRole
maxRole', Bool
anyAdmin')
            | Bool
otherwise = (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember],
 GroupMemberRole, Bool)
acc
      deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
      deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
deleteInvitedMems User
user [GroupMember]
memsToDelete = do
        User
-> [GroupMember]
-> ExceptT ChatError (ReaderT ChatController IO) ()
deleteMembersConnections User
user [GroupMember]
memsToDelete
        ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [GroupMember])
 -> CM ([ChatError], [GroupMember]))
-> ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall a b. (a -> b) -> a -> b
$ [Either ChatError GroupMember] -> ([ChatError], [GroupMember])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError GroupMember] -> ([ChatError], [GroupMember]))
-> ReaderT ChatController IO [Either ChatError GroupMember]
-> ReaderT ChatController IO ([ChatError], [GroupMember])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO GroupMember])
-> ReaderT ChatController IO [Either ChatError GroupMember]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO a)) -> CM' (t (Either ChatError a))
withStoreBatch' (\Connection
db -> (GroupMember -> IO GroupMember)
-> [GroupMember] -> [IO GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (Connection -> GroupMember -> IO GroupMember
delMember Connection
db) [GroupMember]
memsToDelete)
        where
          delMember :: Connection -> GroupMember -> IO GroupMember
delMember Connection
db GroupMember
m = do
            Connection -> User -> GroupMember -> IO ()
deleteGroupMember Connection
db User
user GroupMember
m
            GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m {memberStatus = GSMemRemoved}
      deletePendingMember :: ([ChatError], [GroupMember], [AChatItem]) -> User -> GroupInfo -> [GroupMember] -> GroupMember -> CM ([ChatError], [GroupMember], [AChatItem])
      deletePendingMember :: ([ChatError], [GroupMember], [AChatItem])
-> User
-> GroupInfo
-> [GroupMember]
-> GroupMember
-> CM ([ChatError], [GroupMember], [AChatItem])
deletePendingMember ([ChatError]
accErrs, [GroupMember]
accDeleted, [AChatItem]
accACIs) User
user GroupInfo
gInfo [GroupMember]
recipients GroupMember
m = do
        (GroupMember
m', GroupChatScopeInfo
scopeInfo) <- GroupMember -> CM (GroupMember, GroupChatScopeInfo)
mkMemberSupportChatInfo GroupMember
m
        ([ChatError]
errs, [GroupMember]
deleted, [AChatItem]
acis) <- User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> [GroupMember]
-> CM ([ChatError], [GroupMember], [AChatItem])
deleteMemsSend User
user GroupInfo
gInfo (GroupChatScopeInfo -> Maybe GroupChatScopeInfo
forall a. a -> Maybe a
Just GroupChatScopeInfo
scopeInfo) [GroupMember]
recipients [Item [GroupMember]
GroupMember
m']
        ([ChatError], [GroupMember], [AChatItem])
-> CM ([ChatError], [GroupMember], [AChatItem])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ChatError]
errs [ChatError] -> [ChatError] -> [ChatError]
forall a. Semigroup a => a -> a -> a
<> [ChatError]
accErrs, [GroupMember]
deleted [GroupMember] -> [GroupMember] -> [GroupMember]
forall a. Semigroup a => a -> a -> a
<> [GroupMember]
accDeleted, [AChatItem]
acis [AChatItem] -> [AChatItem] -> [AChatItem]
forall a. Semigroup a => a -> a -> a
<> [AChatItem]
accACIs)
      deleteMemsSend :: User -> GroupInfo -> Maybe GroupChatScopeInfo -> [GroupMember] -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
      deleteMemsSend :: User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> [GroupMember]
-> CM ([ChatError], [GroupMember], [AChatItem])
deleteMemsSend User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [GroupMember]
recipients [GroupMember]
memsToDelete = case [GroupMember] -> Maybe (NonEmpty GroupMember)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty [GroupMember]
memsToDelete of
        Maybe (NonEmpty GroupMember)
Nothing -> ([ChatError], [GroupMember], [AChatItem])
-> CM ([ChatError], [GroupMember], [AChatItem])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [], [])
        Just NonEmpty GroupMember
memsToDelete' -> do
          let chatScope :: Maybe GroupChatScope
chatScope = GroupChatScopeInfo -> GroupChatScope
toChatScope (GroupChatScopeInfo -> GroupChatScope)
-> Maybe GroupChatScopeInfo -> Maybe GroupChatScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupChatScopeInfo
chatScopeInfo
              events :: NonEmpty (ChatMsgEvent 'Json)
events = (GroupMember -> ChatMsgEvent 'Json)
-> NonEmpty GroupMember -> NonEmpty (ChatMsgEvent 'Json)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map (\GroupMember {MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId} -> MemberId -> Bool -> ChatMsgEvent 'Json
XGrpMemDel MemberId
memberId Bool
withMessages) NonEmpty GroupMember
memsToDelete'
          (NonEmpty (Either ChatError SndMessage)
msgs_, GroupSndResult
_gsr) <- User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages User
user GroupInfo
gInfo Maybe GroupChatScope
chatScope [GroupMember]
recipients NonEmpty (ChatMsgEvent 'Json)
events
          let itemsData_ :: [Either ChatError (Maybe (NewSndChatItemData 'CTGroup))]
itemsData_ = (GroupMember
 -> Either ChatError SndMessage
 -> Either ChatError (Maybe (NewSndChatItemData 'CTGroup)))
-> [GroupMember]
-> [Either ChatError SndMessage]
-> [Either ChatError (Maybe (NewSndChatItemData 'CTGroup))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((SndMessage -> Maybe (NewSndChatItemData 'CTGroup))
-> Either ChatError SndMessage
-> Either ChatError (Maybe (NewSndChatItemData 'CTGroup))
forall a b. (a -> b) -> Either ChatError a -> Either ChatError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SndMessage -> Maybe (NewSndChatItemData 'CTGroup))
 -> Either ChatError SndMessage
 -> Either ChatError (Maybe (NewSndChatItemData 'CTGroup)))
-> (GroupMember
    -> SndMessage -> Maybe (NewSndChatItemData 'CTGroup))
-> GroupMember
-> Either ChatError SndMessage
-> Either ChatError (Maybe (NewSndChatItemData 'CTGroup))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupMember -> SndMessage -> Maybe (NewSndChatItemData 'CTGroup)
forall (c :: ChatType).
GroupMember -> SndMessage -> Maybe (NewSndChatItemData c)
sndItemData) [GroupMember]
memsToDelete (NonEmpty (Either ChatError SndMessage)
-> [Either ChatError SndMessage]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Either ChatError SndMessage)
msgs_)
              skipUnwantedItem :: Either a (Maybe b) -> Maybe (Either a b)
skipUnwantedItem = \case
                Right Maybe b
Nothing -> Maybe (Either a b)
forall a. Maybe a
Nothing
                Right (Just b
a) -> Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> Either a b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right b
a
                Left a
e -> Either a b -> Maybe (Either a b)
forall a. a -> Maybe a
Just (Either a b -> Maybe (Either a b))
-> Either a b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
e
              itemsData :: [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData = (Either ChatError (Maybe (NewSndChatItemData 'CTGroup))
 -> Maybe (Either ChatError (NewSndChatItemData 'CTGroup)))
-> [Either ChatError (Maybe (NewSndChatItemData 'CTGroup))]
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either ChatError (Maybe (NewSndChatItemData 'CTGroup))
-> Maybe (Either ChatError (NewSndChatItemData 'CTGroup))
forall {a} {b}. Either a (Maybe b) -> Maybe (Either a b)
skipUnwantedItem [Either ChatError (Maybe (NewSndChatItemData 'CTGroup))]
itemsData_
          [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ <- User
-> ChatDirection 'CTGroup 'MDSnd
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> [Either ChatError (NewSndChatItemData c)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem c 'MDSnd)]
saveSndChatItems User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo) [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData Maybe CITimed
forall a. Maybe a
Nothing Bool
False
          User
-> [GroupMember]
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
deleteMembersConnections' User
user [GroupMember]
memsToDelete Bool
True
          ([ChatError]
errs, [GroupMember]
deleted) <- ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [GroupMember])
 -> CM ([ChatError], [GroupMember]))
-> ReaderT ChatController IO ([ChatError], [GroupMember])
-> CM ([ChatError], [GroupMember])
forall a b. (a -> b) -> a -> b
$ [Either ChatError GroupMember] -> ([ChatError], [GroupMember])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError GroupMember] -> ([ChatError], [GroupMember]))
-> ReaderT ChatController IO [Either ChatError GroupMember]
-> ReaderT ChatController IO ([ChatError], [GroupMember])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO GroupMember])
-> ReaderT ChatController IO [Either ChatError GroupMember]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO a)) -> CM' (t (Either ChatError a))
withStoreBatch' (\Connection
db -> (GroupMember -> IO GroupMember)
-> [GroupMember] -> [IO GroupMember]
forall a b. (a -> b) -> [a] -> [b]
map (Connection -> GroupMember -> IO GroupMember
delMember Connection
db) [GroupMember]
memsToDelete)
          let acis :: [AChatItem]
acis = (ChatItem 'CTGroup 'MDSnd -> AChatItem)
-> [ChatItem 'CTGroup 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map (SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo)) ([ChatItem 'CTGroup 'MDSnd] -> [AChatItem])
-> [ChatItem 'CTGroup 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> a -> b
$ [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> [ChatItem 'CTGroup 'MDSnd]
forall a b. [Either a b] -> [b]
rights [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_
          ([ChatError], [GroupMember], [AChatItem])
-> CM ([ChatError], [GroupMember], [AChatItem])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ChatError]
errs, [GroupMember]
deleted, [AChatItem]
acis)
          where
            sndItemData :: GroupMember -> SndMessage -> Maybe (NewSndChatItemData c)
            sndItemData :: forall (c :: ChatType).
GroupMember -> SndMessage -> Maybe (NewSndChatItemData c)
sndItemData GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, LocalProfile
memberProfile :: GroupMember -> LocalProfile
memberProfile :: LocalProfile
memberProfile, GroupMemberStatus
memberStatus :: GroupMember -> GroupMemberStatus
memberStatus :: GroupMemberStatus
memberStatus} SndMessage
msg
              | GroupMemberStatus
memberStatus GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberStatus
GSMemRemoved Bool -> Bool -> Bool
|| GroupMemberStatus
memberStatus GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberStatus
GSMemLeft = Maybe (NewSndChatItemData c)
forall a. Maybe a
Nothing
              | Bool
otherwise =
                  let content :: CIContent 'MDSnd
content = SndGroupEvent -> CIContent 'MDSnd
CISndGroupEvent (SndGroupEvent -> CIContent 'MDSnd)
-> SndGroupEvent -> CIContent 'MDSnd
forall a b. (a -> b) -> a -> b
$ Int64 -> Profile -> SndGroupEvent
SGEMemberDeleted Int64
groupMemberId (LocalProfile -> Profile
fromLocalProfile LocalProfile
memberProfile)
                      ts :: (Text, Maybe MarkdownList)
ts = CIContent 'MDSnd -> (Text, Maybe MarkdownList)
forall (d :: MsgDirection).
CIContent d -> (Text, Maybe MarkdownList)
ciContentTexts CIContent 'MDSnd
content
                   in NewSndChatItemData c -> Maybe (NewSndChatItemData c)
forall a. a -> Maybe a
Just (NewSndChatItemData c -> Maybe (NewSndChatItemData c))
-> NewSndChatItemData c -> Maybe (NewSndChatItemData c)
forall a b. (a -> b) -> a -> b
$ SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
forall (c :: ChatType).
SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
NewSndChatItemData SndMessage
msg CIContent 'MDSnd
content (Text, Maybe MarkdownList)
ts Map Text CIMention
forall k a. Map k a
M.empty Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing Maybe (CIQuote c)
forall a. Maybe a
Nothing Maybe CIForwardedFrom
forall a. Maybe a
Nothing
            delMember :: Connection -> GroupMember -> IO GroupMember
delMember Connection
db GroupMember
m = do
              -- We're in a function used in batch member deletion, and since we're passing same gInfo for each member,
              -- voided result (updated group info) may have incorrect state of membersRequireAttention.
              -- To avoid complicating code by chaining group info updates,
              -- instead we re-read it once after deleting all members before response.
              IO GroupInfo -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO GroupInfo -> IO ()) -> IO GroupInfo -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> User -> GroupInfo -> GroupMember -> IO GroupInfo
deleteOrUpdateMemberRecordIO Connection
db User
user GroupInfo
gInfo GroupMember
m
              GroupMember -> IO GroupMember
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMember
m {memberStatus = GSMemRemoved}
      deleteMessages :: User
-> GroupInfo
-> [GroupMember]
-> ExceptT ChatError (ReaderT ChatController IO) ()
deleteMessages User
user gInfo :: GroupInfo
gInfo@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} [GroupMember]
ms
        | SGroupFeature 'GFFullDelete -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureUserAllowed SGroupFeature 'GFFullDelete
SGFFullDelete GroupInfo
gInfo = User
-> GroupInfo
-> [GroupMember]
-> GroupMember
-> ExceptT ChatError (ReaderT ChatController IO) ()
deleteGroupMembersCIs User
user GroupInfo
gInfo [GroupMember]
ms GroupMember
membership
        | Bool
otherwise = User
-> GroupInfo
-> [GroupMember]
-> GroupMember
-> ExceptT ChatError (ReaderT ChatController IO) ()
markGroupMembersCIsDeleted User
user GroupInfo
gInfo [GroupMember]
ms GroupMember
membership
  APILeaveGroup Int64
groupId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    gInfo :: GroupInfo
gInfo@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
    [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO [CIFileInfo]
getGroupFileInfo Connection
db User
user GroupInfo
gInfo
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"leaveGroup" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
cancelFilesInProgress User
user [CIFileInfo]
filesInfo
      ([GroupMember]
members, [GroupMember]
recipients) <- User
-> GroupInfo
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
getRecipients User
user GroupInfo
gInfo
      SndMessage
msg <- User
-> GroupInfo
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage
sendGroupMessage' User
user GroupInfo
gInfo [GroupMember]
recipients ChatMsgEvent 'Json
XGrpLeave
      (GroupInfo
gInfo', Maybe GroupChatScopeInfo
scopeInfo) <- GroupInfo -> CM (GroupInfo, Maybe GroupChatScopeInfo)
mkLocalGroupChatScope GroupInfo
gInfo
      ChatItem 'CTGroup 'MDSnd
ci <- User
-> ChatDirection 'CTGroup 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem 'CTGroup 'MDSnd)
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem c 'MDSnd)
saveSndChatItem User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo' Maybe GroupChatScopeInfo
scopeInfo) SndMessage
msg (SndGroupEvent -> CIContent 'MDSnd
CISndGroupEvent SndGroupEvent
SGEUserLeft)
      ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo' Maybe GroupChatScopeInfo
scopeInfo) ChatItem 'CTGroup 'MDSnd
ci]
      -- TODO delete direct connections that were unused
      User
-> GroupInfo -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteGroupLinkIfExists User
user GroupInfo
gInfo'
      -- member records are not deleted to keep history
      User
-> [GroupMember]
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
deleteMembersConnections' User
user [GroupMember]
members Bool
True
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> GroupMember -> GroupMemberStatus -> IO ()
updateGroupMemberStatus Connection
db Int64
userId GroupMember
membership GroupMemberStatus
GSMemLeft
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> ChatResponse
CRLeftMemberUser User
user GroupInfo
gInfo' {membership = membership {memberStatus = GSMemLeft}}
    where
      getRecipients :: User
-> GroupInfo
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
getRecipients User
user gInfo :: GroupInfo
gInfo@GroupInfo {BoolDef
useRelays :: GroupInfo -> BoolDef
useRelays :: BoolDef
useRelays}
        | BoolDef -> Bool
isTrue BoolDef
useRelays = do
            [GroupMember]
relays <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupRelays Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
            ([GroupMember], [GroupMember])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GroupMember]
relays, [GroupMember]
relays)
        | Bool
otherwise = do
            [GroupMember]
ms <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
            ([GroupMember], [GroupMember])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([GroupMember], [GroupMember])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GroupMember]
ms, (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrentOrPending [GroupMember]
ms)
  APIListMembers Int64
groupId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> Group -> ChatResponse
CRGroupMembers User
user (Group -> ChatResponse) -> CM Group -> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Group
getGroup Connection
db VersionRangeChat
vr User
user Int64
groupId)
  -- -- validate: prohibit to delete/archive if member is pending (has to communicate approval or rejection)
  -- APIDeleteGroupConversations groupId _gcId -> withUser $ \user -> do
  --   _gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
  --   ok_ -- CRGroupConversationsArchived
  -- APIArchiveGroupConversations groupId _gcId -> withUser $ \user -> do
  --   _gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId
  --   ok_ -- CRGroupConversationsDeleted
  AddMember Text
gName Text
cName GroupMemberRole
memRole -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Int64
groupId, Int64
contactId) <- (Connection -> ExceptT StoreError IO (Int64, Int64))
-> CM (Int64, Int64)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Int64, Int64))
 -> CM (Int64, Int64))
-> (Connection -> ExceptT StoreError IO (Int64, Int64))
-> CM (Int64, Int64)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (Int64 -> Int64 -> (Int64, Int64))
-> ExceptT StoreError IO Int64
-> ExceptT StoreError IO (Int64 -> (Int64, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName ExceptT StoreError IO (Int64 -> (Int64, Int64))
-> ExceptT StoreError IO Int64
-> ExceptT StoreError IO (Int64, Int64)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
cName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64 -> GroupMemberRole -> ChatCommand
APIAddMember Int64
groupId Int64
contactId GroupMemberRole
memRole
  JoinGroup Text
gName MsgFilter
enableNtfs -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> MsgFilter -> ChatCommand
APIJoinGroup Int64
groupId MsgFilter
enableNtfs
  AcceptMember Text
gName Text
gMemberName GroupMemberRole
memRole -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
gMemberName ((Int64 -> Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
gId Int64
gMemberId -> Int64 -> Int64 -> GroupMemberRole -> ChatCommand
APIAcceptMember Int64
gId Int64
gMemberId GroupMemberRole
memRole
  MemberRole Text
gName Text
gMemberName GroupMemberRole
memRole -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
gMemberName ((Int64 -> Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
gId Int64
gMemberId -> Int64 -> NonEmpty Int64 -> GroupMemberRole -> ChatCommand
APIMembersRole Int64
gId [Int64
Item (NonEmpty Int64)
gMemberId] GroupMemberRole
memRole
  BlockForAll Text
gName Text
gMemberName Bool
blocked -> Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
gMemberName ((Int64 -> Int64 -> ChatCommand) -> CM ChatResponse)
-> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Int64
gId Int64
gMemberId -> Int64 -> NonEmpty Int64 -> Bool -> ChatCommand
APIBlockMembersForAll Int64
gId [Int64
Item (NonEmpty Int64)
gMemberId] Bool
blocked
  RemoveMembers Text
gName NonEmpty Text
gMemberNames Bool
withMessages -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Int64
gId, NonEmpty Int64
gMemberIds) <- (Connection -> ExceptT StoreError IO (Int64, NonEmpty Int64))
-> CM (Int64, NonEmpty Int64)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO (Int64, NonEmpty Int64))
 -> CM (Int64, NonEmpty Int64))
-> (Connection -> ExceptT StoreError IO (Int64, NonEmpty Int64))
-> CM (Int64, NonEmpty Int64)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      Int64
gId <- Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
      NonEmpty Int64
gMemberIds <- (Text -> ExceptT StoreError IO Int64)
-> NonEmpty Text -> ExceptT StoreError IO (NonEmpty Int64)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getGroupMemberIdByName Connection
db User
user Int64
gId) NonEmpty Text
gMemberNames
      (Int64, NonEmpty Int64)
-> ExceptT StoreError IO (Int64, NonEmpty Int64)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
gId, NonEmpty Int64
gMemberIds)
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> NonEmpty Int64 -> Bool -> ChatCommand
APIRemoveMembers Int64
gId NonEmpty Int64
gMemberIds Bool
withMessages
  LeaveGroup Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APILeaveGroup Int64
groupId
  DeleteGroup Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatDeleteMode -> ChatCommand
APIDeleteChat (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup Int64
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing) (Bool -> ChatDeleteMode
CDMFull Bool
True)
  ClearGroup Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatCommand
APIClearChat (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup Int64
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing)
  ListMembers Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIListMembers Int64
groupId
  ListMemberSupportChats Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    (Group GroupInfo
gInfo [GroupMember]
members) <- (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Group) -> CM Group)
-> (Connection -> ExceptT StoreError IO Group) -> CM Group
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Group
getGroup Connection
db VersionRangeChat
vr User
user Int64
groupId
    let memberSupportChats :: [GroupMember]
memberSupportChats = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe GroupSupportChat -> Bool
forall a. Maybe a -> Bool
isJust (Maybe GroupSupportChat -> Bool)
-> (GroupMember -> Maybe GroupSupportChat) -> GroupMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupMember -> Maybe GroupSupportChat
supportChat) [GroupMember]
members
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> [GroupMember] -> ChatResponse
CRMemberSupportChats User
user GroupInfo
gInfo [GroupMember]
memberSupportChats
  APIListGroups Int64
userId Maybe Int64
contactId_ Maybe Text
search_ -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> [GroupInfo] -> ChatResponse
CRGroupsList User
user ([GroupInfo] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [GroupInfo]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [GroupInfo])
-> ExceptT ChatError (ReaderT ChatController IO) [GroupInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Maybe Int64
-> Maybe Text
-> IO [GroupInfo]
getBaseGroupDetails Connection
db VersionRangeChat
vr User
user Maybe Int64
contactId_ Maybe Text
search_)
  ListGroups Maybe Text
cName_ Maybe Text
search_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> do
    Maybe Contact
ct_ <- Maybe Text
-> (Text -> CM Contact)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Contact)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Text
cName_ ((Text -> CM Contact)
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Contact))
-> (Text -> CM Contact)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Contact)
forall a b. (a -> b) -> a -> b
$ \Text
cName -> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Text
-> ExceptT StoreError IO Contact
getContactByName Connection
db VersionRangeChat
vr User
user Text
cName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe Int64 -> Maybe Text -> ChatCommand
APIListGroups Int64
userId (Contact -> Int64
forall a. IsContact a => a -> Int64
contactId' (Contact -> Int64) -> Maybe Contact -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Contact
ct_) Maybe Text
search_
  APIUpdateGroupProfile Int64
groupId GroupProfile
p' -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
    User -> GroupInfo -> GroupProfile -> CM ChatResponse
runUpdateGroupProfile User
user GroupInfo
gInfo GroupProfile
p'
  UpdateGroupNames Text
gName GroupProfile {Text
displayName :: GroupProfile -> Text
displayName :: Text
displayName, Text
fullName :: Text
fullName :: GroupProfile -> Text
fullName, Maybe Text
shortDescr :: Maybe Text
shortDescr :: GroupProfile -> Maybe Text
shortDescr} ->
    Text -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName Text
gName ((GroupProfile -> GroupProfile) -> CM ChatResponse)
-> (GroupProfile -> GroupProfile) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \GroupProfile
p -> GroupProfile
p {displayName, fullName, shortDescr}
  ShowGroupProfile Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> GroupInfo -> ChatResponse
CRGroupProfile User
user (GroupInfo -> ChatResponse) -> CM GroupInfo -> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Text
-> ExceptT StoreError IO GroupInfo
getGroupInfoByName Connection
db VersionRangeChat
vr User
user Text
gName)
  UpdateGroupDescription Text
gName Maybe Text
description ->
    Text -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName Text
gName ((GroupProfile -> GroupProfile) -> CM ChatResponse)
-> (GroupProfile -> GroupProfile) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \GroupProfile
p -> GroupProfile
p {description}
  ShowGroupDescription Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
    User -> GroupInfo -> ChatResponse
CRGroupDescription User
user (GroupInfo -> ChatResponse) -> CM GroupInfo -> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Text
-> ExceptT StoreError IO GroupInfo
getGroupInfoByName Connection
db VersionRangeChat
vr User
user Text
gName)
  APICreateGroupLink Int64
groupId GroupMemberRole
mRole -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"createGroupLink" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    gInfo :: GroupInfo
gInfo@GroupInfo {GroupProfile
groupProfile :: GroupInfo -> GroupProfile
groupProfile :: GroupProfile
groupProfile} <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
    GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo GroupMemberRole
GRAdmin
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMemberRole
mRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
> GroupMemberRole
GRMember) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMemberRole -> ChatErrorType
CEGroupMemberInitialRole GroupInfo
gInfo GroupMemberRole
mRole
    GroupLinkId
groupLinkId <- ByteString -> GroupLinkId
GroupLinkId (ByteString -> GroupLinkId)
-> CM ByteString
-> ExceptT ChatError (ReaderT ChatController IO) GroupLinkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> CM ByteString
drgRandomBytes Int
16
    SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
    let userData :: UserLinkData
userData = GroupShortLinkData -> UserLinkData
forall a. ToJSON a => a -> UserLinkData
encodeShortLinkData (GroupShortLinkData -> UserLinkData)
-> GroupShortLinkData -> UserLinkData
forall a b. (a -> b) -> a -> b
$ GroupProfile -> GroupShortLinkData
GroupShortLinkData GroupProfile
groupProfile
        userLinkData :: UserConnLinkData 'CMContact
userLinkData = UserContactData -> UserConnLinkData 'CMContact
UserContactLinkData UserContactData {direct :: Bool
direct = Bool
True, owners :: [OwnerAuth]
owners = [], relays :: [ConnShortLink 'CMContact]
relays = [], UserLinkData
userData :: UserLinkData
userData :: UserLinkData
userData}
        crClientData :: Text
crClientData = CReqClientData -> Text
forall a. ToJSON a => a -> Text
encodeJSON (CReqClientData -> Text) -> CReqClientData -> Text
forall a b. (a -> b) -> a -> b
$ GroupLinkId -> CReqClientData
CRDataGroup GroupLinkId
groupLinkId
    -- TODO [certs rcv]
    (ByteString
connId, (CreatedLinkContact
ccLink, Maybe (DBEntityId' 'DBStored)
_serviceId)) <- (AgentClient
 -> ExceptT
      AgentErrorType
      IO
      (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored)))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT
       AgentErrorType
       IO
       (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
 -> CM
      (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
-> (AgentClient
    -> ExceptT
         AgentErrorType
         IO
         (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored)))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode 'CMContact
-> Maybe (UserConnLinkData 'CMContact)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> ExceptT
     AgentErrorType
     IO
     (ByteString, (CreatedLinkContact, Maybe (DBEntityId' 'DBStored)))
forall (c :: ConnectionMode).
ConnectionModeI c =>
AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode c
-> Maybe (UserConnLinkData c)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> AE
     (ByteString, (CreatedConnLink c, Maybe (DBEntityId' 'DBStored)))
createConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) Bool
True Bool
True SConnectionMode 'CMContact
SCMContact (UserConnLinkData 'CMContact -> Maybe (UserConnLinkData 'CMContact)
forall a. a -> Maybe a
Just UserConnLinkData 'CMContact
userLinkData) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
crClientData) InitialKeys
IKPQOff SubscriptionMode
subMode
    CreatedLinkContact
ccLink' <- CreatedLinkContact -> CreatedLinkContact
createdGroupLink (CreatedLinkContact -> CreatedLinkContact)
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreatedLinkContact
-> ExceptT ChatError (ReaderT ChatController IO) CreatedLinkContact
forall (m :: ConnectionMode).
CreatedConnLink m -> CM (CreatedConnLink m)
shortenCreatedLink CreatedLinkContact
ccLink
    TVar ChaChaDRG
gVar <- (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random
    GroupLink
gLink <- (Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink)
-> (Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> TVar ChaChaDRG
-> User
-> GroupInfo
-> ByteString
-> CreatedLinkContact
-> GroupLinkId
-> GroupMemberRole
-> SubscriptionMode
-> ExceptT StoreError IO GroupLink
createGroupLink Connection
db TVar ChaChaDRG
gVar User
user GroupInfo
gInfo ByteString
connId CreatedLinkContact
ccLink' GroupLinkId
groupLinkId GroupMemberRole
mRole SubscriptionMode
subMode
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupLink -> ChatResponse
CRGroupLinkCreated User
user GroupInfo
gInfo GroupLink
gLink
  APIGroupLinkMemberRole Int64
groupId GroupMemberRole
mRole' -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"groupLinkMemberRole" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
    gLnk :: GroupLink
gLnk@GroupLink {GroupMemberRole
acceptMemberRole :: GroupMemberRole
acceptMemberRole :: GroupLink -> GroupMemberRole
acceptMemberRole} <- (Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink)
-> (Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
getGroupLink Connection
db User
user GroupInfo
gInfo
    GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo GroupMemberRole
GRAdmin
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMemberRole
mRole' GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
> GroupMemberRole
GRMember) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMemberRole -> ChatErrorType
CEGroupMemberInitialRole GroupInfo
gInfo GroupMemberRole
mRole'
    GroupLink
gLnk' <-
      if GroupMemberRole
mRole' GroupMemberRole -> GroupMemberRole -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupMemberRole
acceptMemberRole
        then (Connection -> IO GroupLink) -> CM GroupLink
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO GroupLink) -> CM GroupLink)
-> (Connection -> IO GroupLink) -> CM GroupLink
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupLink -> GroupMemberRole -> IO GroupLink
setGroupLinkMemberRole Connection
db User
user GroupLink
gLnk GroupMemberRole
mRole'
        else GroupLink -> CM GroupLink
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupLink
gLnk
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupLink -> ChatResponse
CRGroupLink User
user GroupInfo
gInfo GroupLink
gLnk'
  APIDeleteGroupLink Int64
groupId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withGroupLock Text
"deleteGroupLink" Int64
groupId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
    User
-> GroupInfo -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteGroupLink' User
user GroupInfo
gInfo
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> ChatResponse
CRGroupLinkDeleted User
user GroupInfo
gInfo
  APIGetGroupLink Int64
groupId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
    GroupLink
gLnk <- (Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink)
-> (Connection -> ExceptT StoreError IO GroupLink) -> CM GroupLink
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
getGroupLink Connection
db User
user GroupInfo
gInfo
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupLink -> ChatResponse
CRGroupLink User
user GroupInfo
gInfo GroupLink
gLnk
  APIAddGroupShortLink Int64
groupId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
gInfo, GroupLink
gLink) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupLink))
-> CM (GroupInfo, GroupLink)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupLink))
 -> CM (GroupInfo, GroupLink))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupLink))
-> CM (GroupInfo, GroupLink)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      GroupInfo
gInfo <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId
      GroupLink
gLink <- Connection -> User -> GroupInfo -> ExceptT StoreError IO GroupLink
getGroupLink Connection
db User
user GroupInfo
gInfo
      (GroupInfo, GroupLink)
-> ExceptT StoreError IO (GroupInfo, GroupLink)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
gInfo, GroupLink
gLink)
    GroupLink
gLink' <- NetworkRequestMode
-> User -> GroupInfo -> GroupLink -> CM GroupLink
setGroupLinkData NetworkRequestMode
nm User
user GroupInfo
gInfo GroupLink
gLink
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupLink -> ChatResponse
CRGroupLink User
user GroupInfo
gInfo GroupLink
gLink'
  APICreateMemberContact Int64
gId Int64
gMemberId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
g, GroupMember
m) <- (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
 -> CM (GroupInfo, GroupMember))
-> (Connection -> ExceptT StoreError IO (GroupInfo, GroupMember))
-> CM (GroupInfo, GroupMember)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId ExceptT StoreError IO (GroupMember -> (GroupInfo, GroupMember))
-> ExceptT StoreError IO GroupMember
-> ExceptT StoreError IO (GroupInfo, GroupMember)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection
-> VersionRangeChat
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO GroupMember
getGroupMember Connection
db VersionRangeChat
vr User
user Int64
gId Int64
gMemberId
    GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
g GroupMemberRole
GRAuthor
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SGroupFeature 'GFDirectMessages -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureUserAllowed SGroupFeature 'GFDirectMessages
SGFDirectMessages GroupInfo
g) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"direct messages not allowed"
    case GroupMember -> Maybe Connection
memberConn GroupMember
m of
      Just mConn :: Connection
mConn@Connection {VersionRangeChat
peerChatVRange :: Connection -> VersionRangeChat
peerChatVRange :: VersionRangeChat
peerChatVRange} -> do
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (VersionRangeChat -> Version ChatVersion
forall v. VersionRange v -> Version v
maxVersion VersionRangeChat
peerChatVRange Version ChatVersion -> Version ChatVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Version ChatVersion
groupDirectInvVersion) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEPeerChatVRangeIncompatible
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int64 -> Bool) -> Maybe Int64 -> Bool
forall a b. (a -> b) -> a -> b
$ GroupMember -> Maybe Int64
memberContactId GroupMember
m) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"member contact already exists"
        SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
        -- TODO PQ should negotitate contact connection with PQSupportOn?
        -- TODO [certs rcv]
        (ByteString
connId, (CCLink ConnReqInvitation
cReq Maybe ShortLinkInvitation
_, Maybe (DBEntityId' 'DBStored)
_serviceId)) <- (AgentClient
 -> ExceptT
      AgentErrorType
      IO
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT
       AgentErrorType
       IO
       (ByteString,
        (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
 -> CM
      (ByteString,
       (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> (AgentClient
    -> ExceptT
         AgentErrorType
         IO
         (ByteString,
          (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored))))
-> CM
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode 'CMInvitation
-> Maybe (UserConnLinkData 'CMInvitation)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> ExceptT
     AgentErrorType
     IO
     (ByteString,
      (CreatedConnLink 'CMInvitation, Maybe (DBEntityId' 'DBStored)))
forall (c :: ConnectionMode).
ConnectionModeI c =>
AgentClient
-> NetworkRequestMode
-> Int64
-> Bool
-> Bool
-> SConnectionMode c
-> Maybe (UserConnLinkData c)
-> Maybe Text
-> InitialKeys
-> SubscriptionMode
-> AE
     (ByteString, (CreatedConnLink c, Maybe (DBEntityId' 'DBStored)))
createConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) Bool
True Bool
False SConnectionMode 'CMInvitation
SCMInvitation Maybe (UserConnLinkData 'CMInvitation)
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing InitialKeys
IKPQOff SubscriptionMode
subMode
        -- [incognito] reuse membership incognito profile
        Contact
ct <- (Connection -> IO Contact) -> CM Contact
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Contact) -> CM Contact)
-> (Connection -> IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> ByteString
-> ConnReqInvitation
-> GroupInfo
-> GroupMember
-> Connection
-> SubscriptionMode
-> IO Contact
createMemberContact Connection
db User
user ByteString
connId ConnReqInvitation
cReq GroupInfo
g GroupMember
m Connection
mConn SubscriptionMode
subMode
        ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ChatError (ReaderT ChatController IO) AChatItem
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> ChatDirection 'CTDirect 'MDSnd
-> Bool
-> CIContent 'MDSnd
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
User
-> ChatDirection c d
-> Bool
-> CIContent d
-> Maybe SharedMsgId
-> Maybe UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
createChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) Bool
False CIContent 'MDSnd
CIChatBanner Maybe SharedMsgId
forall a. Maybe a
Nothing (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
epochStart)
        -- TODO not sure it is correct to set connections status here?
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> GroupInfo -> GroupMember -> ChatResponse
CRNewMemberContact User
user Contact
ct GroupInfo
g GroupMember
m
      Maybe Connection
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APISendMemberContactInvitation Int64
contactId Maybe MsgContent
msgContent_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (g :: GroupInfo
g@GroupInfo {Int64
groupId :: GroupInfo -> Int64
groupId :: Int64
groupId}, GroupMember
m, Contact
ct, ConnReqInvitation
cReq) <- (Connection
 -> ExceptT
      StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation))
-> CM (GroupInfo, GroupMember, Contact, ConnReqInvitation)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation))
 -> CM (GroupInfo, GroupMember, Contact, ConnReqInvitation))
-> (Connection
    -> ExceptT
         StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation))
-> CM (GroupInfo, GroupMember, Contact, ConnReqInvitation)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT
     StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Contact -> Bool
contactGrpInvSent Contact
ct) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"x.grp.direct.inv already sent"
    case GroupMember -> Maybe Connection
memberConn GroupMember
m of
      Just Connection
mConn -> do
        -- TODO [knocking] send in correct scope - modiy API
        let msg :: ChatMsgEvent 'Json
msg = ConnReqInvitation
-> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
XGrpDirectInv ConnReqInvitation
cReq Maybe MsgContent
msgContent_ Maybe MsgScope
forall a. Maybe a
Nothing
        (SndMessage
sndMsg, Int64
_, PQEncryption
_) <- Connection
-> ChatMsgEvent 'Json
-> Int64
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
forall (e :: MsgEncoding).
MsgEncodingI e =>
Connection
-> ChatMsgEvent e
-> Int64
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (SndMessage, Int64, PQEncryption)
sendDirectMemberMessage Connection
mConn ChatMsgEvent 'Json
msg Int64
groupId
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Contact -> Bool -> IO ()
setContactGrpInvSent Connection
db Contact
ct Bool
True
        let ct' :: Contact
ct' = Contact
ct {contactGrpInvSent = True}
        Maybe MsgContent
-> (MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe MsgContent
msgContent_ ((MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \MsgContent
mc -> do
          ChatItem 'CTDirect 'MDSnd
ci <- User
-> ChatDirection 'CTDirect 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem 'CTDirect 'MDSnd)
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem c 'MDSnd)
saveSndChatItem User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct') SndMessage
sndMsg (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc)
          ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct') ChatItem 'CTDirect 'MDSnd
ci]
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> GroupInfo -> GroupMember -> ChatResponse
CRNewMemberContactSentInv User
user Contact
ct' GroupInfo
g GroupMember
m
      Maybe Connection
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
  APIAcceptMemberContact Int64
contactId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (GroupInfo
g, Connection
mConn, Contact
ct, GroupDirectInvitation
groupDirectInv) <- (Connection
 -> ExceptT
      StoreError
      IO
      (GroupInfo, Connection, Contact, GroupDirectInvitation))
-> CM (GroupInfo, Connection, Contact, GroupDirectInvitation)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError
       IO
       (GroupInfo, Connection, Contact, GroupDirectInvitation))
 -> CM (GroupInfo, Connection, Contact, GroupDirectInvitation))
-> (Connection
    -> ExceptT
         StoreError
         IO
         (GroupInfo, Connection, Contact, GroupDirectInvitation))
-> CM (GroupInfo, Connection, Contact, GroupDirectInvitation)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT
     StoreError
     IO
     (GroupInfo, Connection, Contact, GroupDirectInvitation)
getMemberContactInvited Connection
db VersionRangeChat
vr User
user Int64
contactId
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupDirectInvitation -> Bool
groupDirectInvStartedConnection GroupDirectInvitation
groupDirectInv) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"connection already started"
    User
-> GroupInfo
-> Connection
-> Contact
-> GroupDirectInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
connectMemberContact User
user GroupInfo
g Connection
mConn Contact
ct GroupDirectInvitation
groupDirectInv ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \ChatError
e -> do
      -- get updated contact, in case connection was started
      Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
      ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> AChatInfo -> ChatEvent
CEvtChatInfoUpdated User
user (SChatType 'CTDirect -> ChatInfo 'CTDirect -> AChatInfo
forall (c :: ChatType).
ChatTypeI c =>
SChatType c -> ChatInfo c -> AChatInfo
AChatInfo SChatType 'CTDirect
SCTDirect (ChatInfo 'CTDirect -> AChatInfo)
-> ChatInfo 'CTDirect -> AChatInfo
forall a b. (a -> b) -> a -> b
$ Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct')
      ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
    -- get updated contact (groupDirectInvStartedConnection) with connection
    Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      IO () -> ExceptT StoreError IO ()
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT StoreError IO ())
-> IO () -> ExceptT StoreError IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Contact -> IO ()
setMemberContactStartedConnection Connection
db Contact
ct
      Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> ChatResponse
CRMemberContactAccepted User
user Contact
ct'
    where
      connectMemberContact :: User
-> GroupInfo
-> Connection
-> Contact
-> GroupDirectInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
connectMemberContact User
user GroupInfo
gInfo Connection
mConn Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} GroupDirectInvitation {groupDirectInvLink :: GroupDirectInvitation -> ConnReqInvitation
groupDirectInvLink = ConnReqInvitation
cReq} =
        Text
-> ByteString
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. Text -> ByteString -> CM a -> CM a
withInvitationLock Text
"connect" (ConnReqInvitation -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ConnReqInvitation
cReq) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
          SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
          case Maybe Connection
activeConn of
            -- Nothing is legacy branch for exisiting contacts without prepared connection;
            -- for new member contacts connection is prepared immediately (on xGrpDirectInv),
            -- so incognito profile can be attached to it and be visible in UI before accepting
            Maybe Connection
Nothing -> SubscriptionMode
-> ExceptT ChatError (ReaderT ChatController IO) ()
joinNewConn SubscriptionMode
subMode
            Just conn :: Connection
conn@Connection {ConnStatus
connStatus :: ConnStatus
connStatus :: Connection -> ConnStatus
connStatus} -> case ConnStatus
connStatus of
              ConnStatus
ConnPrepared -> SubscriptionMode
-> Connection -> ExceptT ChatError (ReaderT ChatController IO) ()
joinPreparedConn SubscriptionMode
subMode Connection
conn
              ConnStatus
_ -> ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ChatErrorType
CEException String
"connection already started (past prepared status)"
        where
          joinNewConn :: SubscriptionMode
-> ExceptT ChatError (ReaderT ChatController IO) ()
joinNewConn SubscriptionMode
subMode = do
            -- possible improvement: use agent connRequestPQSupport to determine pqSupport here;
            -- for joinPreparedConn below - same + encodeConnInfoPQ;
            -- same for auto-accept on xGrpDirectInv
            ByteString
acId <- (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ByteString)
 -> CM ByteString)
-> (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> Int64
-> Bool
-> ConnReqInvitation
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
forall (c :: ConnectionMode).
AgentClient
-> Int64
-> Bool
-> ConnectionRequestUri c
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
prepareConnectionToJoin AgentClient
a (User -> Int64
aUserId User
user) Bool
True ConnReqInvitation
cReq PQSupport
PQSupportOff
            Connection
conn <- (Connection -> ExceptT StoreError IO Connection) -> CM Connection
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO Connection) -> CM Connection)
-> (Connection -> ExceptT StoreError IO Connection)
-> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
              Int64
connId <- IO Int64 -> ExceptT StoreError IO Int64
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> ExceptT StoreError IO Int64)
-> IO Int64 -> ExceptT StoreError IO Int64
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> ByteString
-> Maybe Int64
-> GroupInfo
-> Connection
-> ConnStatus
-> Int64
-> SubscriptionMode
-> IO Int64
createMemberContactConn Connection
db User
user ByteString
acId Maybe Int64
forall a. Maybe a
Nothing GroupInfo
gInfo Connection
mConn ConnStatus
ConnPrepared Int64
contactId SubscriptionMode
subMode
              Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Connection
getConnectionById Connection
db VersionRangeChat
vr User
user Int64
connId
            SubscriptionMode
-> Connection -> ExceptT ChatError (ReaderT ChatController IO) ()
joinPreparedConn SubscriptionMode
subMode Connection
conn
          joinPreparedConn :: SubscriptionMode
-> Connection -> ExceptT ChatError (ReaderT ChatController IO) ()
joinPreparedConn SubscriptionMode
subMode Connection
conn = do
            -- [incognito] send membership incognito profile
            let p :: Profile
p = User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user (LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> Maybe LocalProfile -> Maybe Profile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GroupInfo -> Maybe LocalProfile
incognitoMembershipProfile GroupInfo
gInfo) Maybe Contact
forall a. Maybe a
Nothing Bool
True
            ByteString
dm <- ChatMsgEvent 'Json -> CM ByteString
forall (e :: MsgEncoding).
MsgEncodingI e =>
ChatMsgEvent e -> CM ByteString
encodeConnInfo (ChatMsgEvent 'Json -> CM ByteString)
-> ChatMsgEvent 'Json -> CM ByteString
forall a b. (a -> b) -> a -> b
$ Profile -> ChatMsgEvent 'Json
XInfo Profile
p
            (Bool
sqSecured, Maybe (DBEntityId' 'DBStored)
_serviceId) <- (AgentClient
 -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Bool, Maybe (DBEntityId' 'DBStored)))
-> (AgentClient
    -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnReqInvitation
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
forall (c :: ConnectionMode).
AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnectionRequestUri c
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
joinConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) (Connection -> ByteString
aConnId Connection
conn) Bool
True ConnReqInvitation
cReq ByteString
dm PQSupport
PQSupportOff SubscriptionMode
subMode
            let newStatus :: ConnStatus
newStatus = if Bool
sqSecured then ConnStatus
ConnSndReady else ConnStatus
ConnJoined
            CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM Connection
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (Connection -> IO Connection) -> CM Connection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Connection) -> CM Connection)
-> (Connection -> IO Connection) -> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Connection -> ConnStatus -> ConnStatus -> IO Connection
updateConnectionStatusFromTo Connection
db Connection
conn ConnStatus
ConnPrepared ConnStatus
newStatus
  CreateGroupLink Text
gName GroupMemberRole
mRole -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> GroupMemberRole -> ChatCommand
APICreateGroupLink Int64
groupId GroupMemberRole
mRole
  GroupLinkMemberRole Text
gName GroupMemberRole
mRole -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> GroupMemberRole -> ChatCommand
APIGroupLinkMemberRole Int64
groupId GroupMemberRole
mRole
  DeleteGroupLink Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIDeleteGroupLink Int64
groupId
  ShowGroupLink Text
gName -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
groupId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatCommand
APIGetGroupLink Int64
groupId
  SendGroupMessageQuote Text
gName Maybe Text
cName Text
quotedMsg Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Int64
groupId, Int64
quotedItemId, Map Text Int64
mentions) <-
      (Connection
 -> ExceptT StoreError IO (Int64, Int64, Map Text Int64))
-> CM (Int64, Int64, Map Text Int64)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT StoreError IO (Int64, Int64, Map Text Int64))
 -> CM (Int64, Int64, Map Text Int64))
-> (Connection
    -> ExceptT StoreError IO (Int64, Int64, Map Text Int64))
-> CM (Int64, Int64, Map Text Int64)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        Int64
gId <- Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
        Int64
qiId <- Connection
-> User
-> Int64
-> Maybe Text
-> Text
-> ExceptT StoreError IO Int64
getGroupChatItemIdByText Connection
db User
user Int64
gId Maybe Text
cName Text
quotedMsg
        (Int64
gId, Int64
qiId,) (Map Text Int64 -> (Int64, Int64, Map Text Int64))
-> ExceptT StoreError IO (Map Text Int64)
-> ExceptT StoreError IO (Int64, Int64, Map Text Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map Text Int64) -> ExceptT StoreError IO (Map Text Int64)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> User -> Int64 -> Text -> IO (Map Text Int64)
getMessageMentions Connection
db User
user Int64
gId Text
msg)
    let mc :: MsgContent
mc = Text -> MsgContent
MCText Text
msg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages (Int64 -> Maybe GroupChatScope -> SendRef
SRGroup Int64
groupId Maybe GroupChatScope
forall a. Maybe a
Nothing) Bool
False Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile
-> Maybe Int64 -> MsgContent -> Map Text Int64 -> ComposedMessage
ComposedMessage Maybe CryptoFile
forall a. Maybe a
Nothing (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
quotedItemId) MsgContent
mc Map Text Int64
mentions]
  ChatCommand
ClearNoteFolder -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    Int64
folderId <- (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO Int64
`getUserNoteFolderId` User
user)
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatCommand
APIClearChat (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTLocal Int64
folderId Maybe GroupChatScope
forall a. Maybe a
Nothing)
  LastChats Maybe Int
count_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser' ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    let count :: Int
count = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
5000 Maybe Int
count_
    ([StoreError]
errs, [AChat]
previews) <- [Either StoreError AChat] -> ([StoreError], [AChat])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either StoreError AChat] -> ([StoreError], [AChat]))
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either StoreError AChat]
-> ExceptT
     ChatError (ReaderT ChatController IO) ([StoreError], [AChat])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [Either StoreError AChat])
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either StoreError AChat]
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Bool
-> PaginationByTime
-> ChatListQuery
-> IO [Either StoreError AChat]
getChatPreviews Connection
db VersionRangeChat
vr User
user Bool
False (Int -> PaginationByTime
PTLast Int
count) ChatListQuery
clqNoFilters)
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([StoreError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [StoreError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors ((StoreError -> ChatError) -> [StoreError] -> [ChatError]
forall a b. (a -> b) -> [a] -> [b]
map StoreError -> ChatError
ChatErrorStore [StoreError]
errs)
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ [AChat] -> ChatResponse
CRChats [AChat]
previews
  LastMessages (Just ChatName
chatName) Int
count Maybe Text
search -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    ChatResponse
chatResp <- VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef
-> Maybe MsgContentTag
-> ChatPagination
-> Maybe Text
-> ChatCommand
APIGetChat ChatRef
chatRef Maybe MsgContentTag
forall a. Maybe a
Nothing (Int -> ChatPagination
CPLast Int
count) Maybe Text
search
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe ChatName -> [AChatItem] -> ChatResponse
CRChatItems User
user (ChatName -> Maybe ChatName
forall a. a -> Maybe a
Just ChatName
chatName) (AChat -> [AChatItem]
aChatItems (AChat -> [AChatItem])
-> (ChatResponse -> AChat) -> ChatResponse -> [AChatItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatResponse -> AChat
chat (ChatResponse -> [AChatItem]) -> ChatResponse -> [AChatItem]
forall a b. (a -> b) -> a -> b
$ ChatResponse
chatResp)
  LastMessages Maybe ChatName
Nothing Int
count Maybe Text
search -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [AChatItem]
chatItems <- (Connection -> ExceptT StoreError IO [AChatItem]) -> CM [AChatItem]
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO [AChatItem])
 -> CM [AChatItem])
-> (Connection -> ExceptT StoreError IO [AChatItem])
-> CM [AChatItem]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> ChatPagination
-> Maybe Text
-> ExceptT StoreError IO [AChatItem]
getAllChatItems Connection
db VersionRangeChat
vr User
user (Int -> ChatPagination
CPLast Int
count) Maybe Text
search
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe ChatName -> [AChatItem] -> ChatResponse
CRChatItems User
user Maybe ChatName
forall a. Maybe a
Nothing [AChatItem]
chatItems
  LastChatItemId (Just ChatName
chatName) Int
index -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    ChatResponse
chatResp <- VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef
-> Maybe MsgContentTag
-> ChatPagination
-> Maybe Text
-> ChatCommand
APIGetChat ChatRef
chatRef Maybe MsgContentTag
forall a. Maybe a
Nothing (Int -> ChatPagination
CPLast (Int -> ChatPagination) -> Int -> ChatPagination
forall a b. (a -> b) -> a -> b
$ Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Text
forall a. Maybe a
Nothing
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe Int64 -> ChatResponse
CRChatItemId User
user ((AChatItem -> Int64) -> Maybe AChatItem -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AChatItem -> Int64
aChatItemId (Maybe AChatItem -> Maybe Int64)
-> (ChatResponse -> Maybe AChatItem) -> ChatResponse -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AChatItem] -> Maybe AChatItem
forall a. [a] -> Maybe a
listToMaybe ([AChatItem] -> Maybe AChatItem)
-> (ChatResponse -> [AChatItem]) -> ChatResponse -> Maybe AChatItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AChat -> [AChatItem]
aChatItems (AChat -> [AChatItem])
-> (ChatResponse -> AChat) -> ChatResponse -> [AChatItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatResponse -> AChat
chat (ChatResponse -> Maybe Int64) -> ChatResponse -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ ChatResponse
chatResp)
  LastChatItemId Maybe ChatName
Nothing Int
index -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [AChatItem]
chatItems <- (Connection -> ExceptT StoreError IO [AChatItem]) -> CM [AChatItem]
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO [AChatItem])
 -> CM [AChatItem])
-> (Connection -> ExceptT StoreError IO [AChatItem])
-> CM [AChatItem]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> ChatPagination
-> Maybe Text
-> ExceptT StoreError IO [AChatItem]
getAllChatItems Connection
db VersionRangeChat
vr User
user (Int -> ChatPagination
CPLast (Int -> ChatPagination) -> Int -> ChatPagination
forall a b. (a -> b) -> a -> b
$ Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Text
forall a. Maybe a
Nothing
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe Int64 -> ChatResponse
CRChatItemId User
user ((AChatItem -> Int64) -> Maybe AChatItem -> Maybe Int64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AChatItem -> Int64
aChatItemId (Maybe AChatItem -> Maybe Int64)
-> ([AChatItem] -> Maybe AChatItem) -> [AChatItem] -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AChatItem] -> Maybe AChatItem
forall a. [a] -> Maybe a
listToMaybe ([AChatItem] -> Maybe Int64) -> [AChatItem] -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ [AChatItem]
chatItems)
  ShowChatItem (Just Int64
itemId) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    AChatItem
chatItem <- (Connection -> ExceptT StoreError IO AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO AChatItem)
 -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> (Connection -> ExceptT StoreError IO AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      ChatRef
chatRef <- Connection -> User -> Int64 -> ExceptT StoreError IO ChatRef
getChatRefViaItemId Connection
db User
user Int64
itemId
      Connection
-> VersionRangeChat
-> User
-> ChatRef
-> Int64
-> ExceptT StoreError IO AChatItem
getAChatItem Connection
db VersionRangeChat
vr User
user ChatRef
chatRef Int64
itemId
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe ChatName -> [AChatItem] -> ChatResponse
CRChatItems User
user Maybe ChatName
forall a. Maybe a
Nothing ((AChatItem -> [AChatItem] -> [AChatItem]
forall a. a -> [a] -> [a]
: []) AChatItem
chatItem)
  ShowChatItem Maybe Int64
Nothing -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [AChatItem]
chatItems <- (Connection -> ExceptT StoreError IO [AChatItem]) -> CM [AChatItem]
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO [AChatItem])
 -> CM [AChatItem])
-> (Connection -> ExceptT StoreError IO [AChatItem])
-> CM [AChatItem]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> ChatPagination
-> Maybe Text
-> ExceptT StoreError IO [AChatItem]
getAllChatItems Connection
db VersionRangeChat
vr User
user (Int -> ChatPagination
CPLast Int
1) Maybe Text
forall a. Maybe a
Nothing
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe ChatName -> [AChatItem] -> ChatResponse
CRChatItems User
user Maybe ChatName
forall a. Maybe a
Nothing [AChatItem]
chatItems
  ShowChatItemInfo ChatName
chatName Text
msg -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    Int64
itemId <- User -> ChatRef -> Text -> CM Int64
getChatItemIdByText User
user ChatRef
chatRef Text
msg
    VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> Int64 -> ChatCommand
APIGetChatItemInfo ChatRef
chatRef Int64
itemId
  ShowLiveItems Bool
on -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ ->
    (ChatController -> TVar Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar Bool
showLiveItems ExceptT ChatError (ReaderT ChatController IO) (TVar Bool)
-> (TVar Bool -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (TVar Bool -> STM ())
-> TVar Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
`writeTVar` Bool
on) ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  SendFile ChatName
chatName CryptoFile
f -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    case ChatRef
chatRef of
      ChatRef ChatType
CTLocal Int64
folderId Maybe GroupChatScope
_ -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> NonEmpty ComposedMessage -> ChatCommand
APICreateChatItems Int64
folderId [Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage (CryptoFile -> Maybe CryptoFile
forall a. a -> Maybe a
Just CryptoFile
f) (Text -> MsgContent
MCFile Text
"")]
      ChatRef
_ -> ChatRef -> (SendRef -> CM ChatResponse) -> CM ChatResponse
withSendRef ChatRef
chatRef ((SendRef -> CM ChatResponse) -> CM ChatResponse)
-> (SendRef -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \SendRef
sendRef -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages SendRef
sendRef Bool
False Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage (CryptoFile -> Maybe CryptoFile
forall a. a -> Maybe a
Just CryptoFile
f) (Text -> MsgContent
MCFile Text
"")]
  SendImage ChatName
chatName f :: CryptoFile
f@(CryptoFile String
fPath Maybe CryptoFileArgs
_) -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ChatRef
chatRef <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
chatName
    ChatRef -> (SendRef -> CM ChatResponse) -> CM ChatResponse
withSendRef ChatRef
chatRef ((SendRef -> CM ChatResponse) -> CM ChatResponse)
-> (SendRef -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \SendRef
sendRef -> do
      String
filePath <- ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO String
 -> ExceptT ChatError (ReaderT ChatController IO) String)
-> ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall a b. (a -> b) -> a -> b
$ String -> ReaderT ChatController IO String
toFSFilePath String
fPath
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fPath) [String]
imageExtensions) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError CEFileImageType {String
filePath :: String
filePath :: String
filePath}
      Integer
fileSize <- String -> ExceptT ChatError (ReaderT ChatController IO) Integer
forall (m :: * -> *). MonadIO m => String -> m Integer
getFileSize String
filePath
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Integer
fileSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxImageSize) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError CEFileImageSize {String
filePath :: String
filePath :: String
filePath}
      -- TODO include file description for preview
      VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages SendRef
sendRef Bool
False Maybe Int
forall a. Maybe a
Nothing [Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage (CryptoFile -> Maybe CryptoFile
forall a. a -> Maybe a
Just CryptoFile
f) (Text -> ImageData -> MsgContent
MCImage Text
"" ImageData
fixedImagePreview)]
  ForwardFile ChatName
chatName Int64
fileId -> ChatName
-> Int64
-> (ChatName -> CryptoFile -> ChatCommand)
-> CM ChatResponse
forwardFile ChatName
chatName Int64
fileId ChatName -> CryptoFile -> ChatCommand
SendFile
  ForwardImage ChatName
chatName Int64
fileId -> ChatName
-> Int64
-> (ChatName -> CryptoFile -> ChatCommand)
-> CM ChatResponse
forwardFile ChatName
chatName Int64
fileId ChatName -> CryptoFile -> ChatCommand
SendImage
  SendFileDescription ChatName
_chatName String
_f -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"TODO"
  -- TODO to use priority transactions we need a parameter that differentiates manual and automatic acceptance
  ReceiveFile Int64
fileId Bool
userApprovedRelays Maybe Bool
encrypted_ Maybe Bool
rcvInline_ Maybe String
filePath_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ ->
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withFileLock Text
"receiveFile" Int64
fileId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      (User
user, ft :: RcvFileTransfer
ft@RcvFileTransfer {RcvFileStatus
fileStatus :: RcvFileStatus
fileStatus :: RcvFileTransfer -> RcvFileStatus
fileStatus}) <- (Connection -> ExceptT StoreError IO (User, RcvFileTransfer))
-> CM (User, RcvFileTransfer)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore (Connection
-> Int64 -> ExceptT StoreError IO (User, RcvFileTransfer)
`getRcvFileTransferById` Int64
fileId)
      Bool
encrypt <- (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
`fromMaybe` Maybe Bool
encrypted_) (Bool -> Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatController -> TVar Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar Bool
encryptLocalFiles
      RcvFileTransfer
ft' <- (if Bool
encrypt Bool -> Bool -> Bool
&& RcvFileStatus
fileStatus RcvFileStatus -> RcvFileStatus -> Bool
forall a. Eq a => a -> a -> Bool
== RcvFileStatus
RFSNew then RcvFileTransfer -> CM RcvFileTransfer
setFileToEncrypt else RcvFileTransfer -> CM RcvFileTransfer
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) RcvFileTransfer
ft
      User
-> RcvFileTransfer
-> Bool
-> Maybe Bool
-> Maybe String
-> CM ChatResponse
receiveFile' User
user RcvFileTransfer
ft' Bool
userApprovedRelays Maybe Bool
rcvInline_ Maybe String
filePath_
  SetFileToReceive Int64
fileId Bool
userApprovedRelays Maybe Bool
encrypted_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> do
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withFileLock Text
"setFileToReceive" Int64
fileId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
      Bool
encrypt <- (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
`fromMaybe` Maybe Bool
encrypted_) (Bool -> Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatController -> TVar Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar Bool
encryptLocalFiles
      Maybe CryptoFileArgs
cfArgs <- if Bool
encrypt then CryptoFileArgs -> Maybe CryptoFileArgs
forall a. a -> Maybe a
Just (CryptoFileArgs -> Maybe CryptoFileArgs)
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (STM CryptoFileArgs
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM CryptoFileArgs
 -> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs)
-> (TVar ChaChaDRG -> STM CryptoFileArgs)
-> TVar ChaChaDRG
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar ChaChaDRG -> STM CryptoFileArgs
CF.randomArgs (TVar ChaChaDRG
 -> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFileArgs
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random) else Maybe CryptoFileArgs
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe CryptoFileArgs)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CryptoFileArgs
forall a. Maybe a
Nothing
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Bool -> Maybe CryptoFileArgs -> IO ()
setRcvFileToReceive Connection
db Int64
fileId Bool
userApprovedRelays Maybe CryptoFileArgs
cfArgs
      CM ChatResponse
ok_
  CancelFile Int64
fileId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} ->
    Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withFileLock Text
"cancelFile" Int64
fileId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
      (Connection -> ExceptT StoreError IO FileTransfer)
-> CM FileTransfer
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer
getFileTransfer Connection
db User
user Int64
fileId) CM FileTransfer
-> (FileTransfer -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        FTSnd ftm :: FileTransferMeta
ftm@FileTransferMeta {Maybe XFTPSndFile
xftpSndFile :: Maybe XFTPSndFile
xftpSndFile :: FileTransferMeta -> Maybe XFTPSndFile
xftpSndFile, Bool
cancelled :: Bool
cancelled :: FileTransferMeta -> Bool
cancelled} [SndFileTransfer]
fts
          | Bool
cancelled -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> String -> ChatErrorType
CEFileCancel Int64
fileId String
"file already cancelled"
          | Bool -> Bool
not ([SndFileTransfer] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SndFileTransfer]
fts) Bool -> Bool -> Bool
&& (SndFileTransfer -> Bool) -> [SndFileTransfer] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SndFileTransfer -> Bool
fileCancelledOrCompleteSMP [SndFileTransfer]
fts ->
              ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> String -> ChatErrorType
CEFileCancel Int64
fileId String
"file transfer is complete"
          | Bool
otherwise -> do
              User
-> FileTransferMeta
-> [SndFileTransfer]
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
cancelSndFile User
user FileTransferMeta
ftm [SndFileTransfer]
fts Bool
True
              Maybe ChatRef
cref_ <- (Connection -> IO (Maybe ChatRef)) -> CM (Maybe ChatRef)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (Maybe ChatRef)) -> CM (Maybe ChatRef))
-> (Connection -> IO (Maybe ChatRef)) -> CM (Maybe ChatRef)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> IO (Maybe ChatRef)
lookupChatRefByFileId Connection
db User
user Int64
fileId
              Maybe AChatItem
aci_ <- (Connection -> ExceptT StoreError IO (Maybe AChatItem))
-> CM (Maybe AChatItem)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Maybe AChatItem))
 -> CM (Maybe AChatItem))
-> (Connection -> ExceptT StoreError IO (Maybe AChatItem))
-> CM (Maybe AChatItem)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId Connection
db VersionRangeChat
vr User
user Int64
fileId
              case (Maybe ChatRef
cref_, Maybe AChatItem
aci_) of
                (Maybe ChatRef
Nothing, Maybe AChatItem
_) ->
                  ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> Maybe AChatItem
-> FileTransferMeta
-> [SndFileTransfer]
-> ChatResponse
CRSndFileCancelled User
user Maybe AChatItem
forall a. Maybe a
Nothing FileTransferMeta
ftm [SndFileTransfer]
fts
                (Just (ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
_), Just AChatItem
aci) -> do
                  (Contact
contact, SharedMsgId
sharedMsgId) <- (Connection -> ExceptT StoreError IO (Contact, SharedMsgId))
-> CM (Contact, SharedMsgId)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Contact, SharedMsgId))
 -> CM (Contact, SharedMsgId))
-> (Connection -> ExceptT StoreError IO (Contact, SharedMsgId))
-> CM (Contact, SharedMsgId)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (Contact -> SharedMsgId -> (Contact, SharedMsgId))
-> ExceptT StoreError IO Contact
-> ExceptT StoreError IO (SharedMsgId -> (Contact, SharedMsgId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId ExceptT StoreError IO (SharedMsgId -> (Contact, SharedMsgId))
-> ExceptT StoreError IO SharedMsgId
-> ExceptT StoreError IO (Contact, SharedMsgId)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> Int64 -> Int64 -> ExceptT StoreError IO SharedMsgId
getSharedMsgIdByFileId Connection
db Int64
userId Int64
fileId
                  CM (SndMessage, Int64)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM (SndMessage, Int64)
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
contact (ChatMsgEvent 'Json
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ SharedMsgId -> ChatMsgEvent 'Json
XFileCancel SharedMsgId
sharedMsgId
                  ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> Maybe AChatItem
-> FileTransferMeta
-> [SndFileTransfer]
-> ChatResponse
CRSndFileCancelled User
user (AChatItem -> Maybe AChatItem
forall a. a -> Maybe a
Just AChatItem
aci) FileTransferMeta
ftm [SndFileTransfer]
fts
                (Just (ChatRef ChatType
CTGroup Int64
groupId Maybe GroupChatScope
scope), Just AChatItem
aci) -> do
                  (GroupInfo
gInfo, SharedMsgId
sharedMsgId) <- (Connection -> ExceptT StoreError IO (GroupInfo, SharedMsgId))
-> CM (GroupInfo, SharedMsgId)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (GroupInfo, SharedMsgId))
 -> CM (GroupInfo, SharedMsgId))
-> (Connection -> ExceptT StoreError IO (GroupInfo, SharedMsgId))
-> CM (GroupInfo, SharedMsgId)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> (,) (GroupInfo -> SharedMsgId -> (GroupInfo, SharedMsgId))
-> ExceptT StoreError IO GroupInfo
-> ExceptT StoreError IO (SharedMsgId -> (GroupInfo, SharedMsgId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId ExceptT StoreError IO (SharedMsgId -> (GroupInfo, SharedMsgId))
-> ExceptT StoreError IO SharedMsgId
-> ExceptT StoreError IO (GroupInfo, SharedMsgId)
forall a b.
ExceptT StoreError IO (a -> b)
-> ExceptT StoreError IO a -> ExceptT StoreError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> Int64 -> Int64 -> ExceptT StoreError IO SharedMsgId
getSharedMsgIdByFileId Connection
db Int64
userId Int64
fileId
                  Maybe GroupChatScopeInfo
chatScopeInfo <- (GroupChatScope
 -> ExceptT
      ChatError (ReaderT ChatController IO) GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (VersionRangeChat
-> User
-> GroupChatScope
-> ExceptT ChatError (ReaderT ChatController IO) GroupChatScopeInfo
getChatScopeInfo VersionRangeChat
vr User
user) Maybe GroupChatScope
scope
                  [GroupMember]
recipients <- VersionRangeChat
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Version ChatVersion
-> CM [GroupMember]
getGroupRecipients VersionRangeChat
vr User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo Version ChatVersion
groupKnockingVersion
                  CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatMsgEvent 'Json -> CM SndMessage)
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent e
-> CM SndMessage
sendGroupMessage User
user GroupInfo
gInfo Maybe GroupChatScope
scope [GroupMember]
recipients (ChatMsgEvent 'Json
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatMsgEvent 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ SharedMsgId -> ChatMsgEvent 'Json
XFileCancel SharedMsgId
sharedMsgId
                  ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> Maybe AChatItem
-> FileTransferMeta
-> [SndFileTransfer]
-> ChatResponse
CRSndFileCancelled User
user (AChatItem -> Maybe AChatItem
forall a. a -> Maybe a
Just AChatItem
aci) FileTransferMeta
ftm [SndFileTransfer]
fts
                (Just ChatRef
_, Maybe AChatItem
_) -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ String -> ChatErrorType
CEFileInternal String
"invalid chat ref for file transfer"
          where
            fileCancelledOrCompleteSMP :: SndFileTransfer -> Bool
fileCancelledOrCompleteSMP SndFileTransfer {fileStatus :: SndFileTransfer -> FileStatus
fileStatus = FileStatus
s} =
              FileStatus
s FileStatus -> FileStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus
FSCancelled Bool -> Bool -> Bool
|| (FileStatus
s FileStatus -> FileStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FileStatus
FSComplete Bool -> Bool -> Bool
&& Maybe XFTPSndFile -> Bool
forall a. Maybe a -> Bool
isNothing Maybe XFTPSndFile
xftpSndFile)
        FTRcv ftr :: RcvFileTransfer
ftr@RcvFileTransfer {Bool
cancelled :: Bool
cancelled :: RcvFileTransfer -> Bool
cancelled, RcvFileStatus
fileStatus :: RcvFileTransfer -> RcvFileStatus
fileStatus :: RcvFileStatus
fileStatus, Maybe XFTPRcvFile
xftpRcvFile :: Maybe XFTPRcvFile
xftpRcvFile :: RcvFileTransfer -> Maybe XFTPRcvFile
xftpRcvFile}
          | Bool
cancelled -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> String -> ChatErrorType
CEFileCancel Int64
fileId String
"file already cancelled"
          | RcvFileStatus -> Bool
rcvFileComplete RcvFileStatus
fileStatus -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> String -> ChatErrorType
CEFileCancel Int64
fileId String
"file transfer is complete"
          | Bool
otherwise -> case Maybe XFTPRcvFile
xftpRcvFile of
              Maybe XFTPRcvFile
Nothing -> do
                User
-> RcvFileTransfer
-> ExceptT ChatError (ReaderT ChatController IO) ()
cancelRcvFileTransfer User
user RcvFileTransfer
ftr
                Maybe AChatItem
ci <- (Connection -> ExceptT StoreError IO (Maybe AChatItem))
-> CM (Maybe AChatItem)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Maybe AChatItem))
 -> CM (Maybe AChatItem))
-> (Connection -> ExceptT StoreError IO (Maybe AChatItem))
-> CM (Maybe AChatItem)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId Connection
db VersionRangeChat
vr User
user Int64
fileId
                ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe AChatItem -> RcvFileTransfer -> ChatResponse
CRRcvFileCancelled User
user Maybe AChatItem
ci RcvFileTransfer
ftr
              Just XFTPRcvFile {Maybe AgentRcvFileId
agentRcvFileId :: Maybe AgentRcvFileId
agentRcvFileId :: XFTPRcvFile -> Maybe AgentRcvFileId
agentRcvFileId} -> do
                Maybe String
-> (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (RcvFileTransfer -> Maybe String
liveRcvFileTransferPath RcvFileTransfer
ftr) ((String -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \String
filePath -> do
                  String
fsFilePath <- ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO String
 -> ExceptT ChatError (ReaderT ChatController IO) String)
-> ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall a b. (a -> b) -> a -> b
$ String -> ReaderT ChatController IO String
toFSFilePath String
filePath
                  IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
removeFile String
fsFilePath IO () -> IO () -> IO ()
forall a. IO a -> IO a -> IO a
`catchAll_` () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((AgentRcvFileId -> ReaderT ChatController IO ())
    -> ReaderT ChatController IO ())
-> (AgentRcvFileId -> ReaderT ChatController IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe AgentRcvFileId
-> (AgentRcvFileId -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe AgentRcvFileId
agentRcvFileId ((AgentRcvFileId -> ReaderT ChatController IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (AgentRcvFileId -> ReaderT ChatController IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \(AgentRcvFileId ByteString
aFileId) ->
                  (AgentClient -> IO ()) -> ReaderT ChatController IO ()
forall a. (AgentClient -> IO a) -> CM' a
withAgent' (AgentClient -> ByteString -> IO ()
`xftpDeleteRcvFile` ByteString
aFileId)
                Maybe AChatItem
aci_ <- User -> Int64 -> CIFileStatus 'MDRcv -> CM (Maybe AChatItem)
resetRcvCIFileStatus User
user Int64
fileId CIFileStatus 'MDRcv
CIFSRcvInvitation
                ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Maybe AChatItem -> RcvFileTransfer -> ChatResponse
CRRcvFileCancelled User
user Maybe AChatItem
aci_ RcvFileTransfer
ftr
  FileStatus Int64
fileId -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    (Connection -> ExceptT StoreError IO (Maybe AChatItem))
-> CM (Maybe AChatItem)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId Connection
db VersionRangeChat
vr User
user Int64
fileId) CM (Maybe AChatItem)
-> (Maybe AChatItem -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe AChatItem
Nothing -> do
        (FileTransfer, [Integer])
fileStatus <- (Connection -> ExceptT StoreError IO (FileTransfer, [Integer]))
-> CM (FileTransfer, [Integer])
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (FileTransfer, [Integer]))
 -> CM (FileTransfer, [Integer]))
-> (Connection -> ExceptT StoreError IO (FileTransfer, [Integer]))
-> CM (FileTransfer, [Integer])
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User -> Int64 -> ExceptT StoreError IO (FileTransfer, [Integer])
getFileTransferProgress Connection
db User
user Int64
fileId
        ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> (FileTransfer, [Integer]) -> ChatResponse
CRFileTransferStatus User
user (FileTransfer, [Integer])
fileStatus
      Just ci :: AChatItem
ci@(AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
_ ChatItem {Maybe (CIFile d)
file :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe (CIFile d)
file :: Maybe (CIFile d)
file}) -> case Maybe (CIFile d)
file of
        Just CIFile {fileProtocol :: forall (d :: MsgDirection). CIFile d -> FileProtocol
fileProtocol = FileProtocol
FPLocal} ->
          String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported for local files"
        Just CIFile {fileProtocol :: forall (d :: MsgDirection). CIFile d -> FileProtocol
fileProtocol = FileProtocol
FPXFTP} ->
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> AChatItem -> ChatResponse
CRFileTransferStatusXFTP User
user AChatItem
ci
        Maybe (CIFile d)
_ -> do
          (FileTransfer, [Integer])
fileStatus <- (Connection -> ExceptT StoreError IO (FileTransfer, [Integer]))
-> CM (FileTransfer, [Integer])
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (FileTransfer, [Integer]))
 -> CM (FileTransfer, [Integer]))
-> (Connection -> ExceptT StoreError IO (FileTransfer, [Integer]))
-> CM (FileTransfer, [Integer])
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User -> Int64 -> ExceptT StoreError IO (FileTransfer, [Integer])
getFileTransferProgress Connection
db User
user Int64
fileId
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> (FileTransfer, [Integer]) -> ChatResponse
CRFileTransferStatus User
user (FileTransfer, [Integer])
fileStatus
  ChatCommand
ShowProfile -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {LocalProfile
profile :: User -> LocalProfile
profile :: LocalProfile
profile} -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Profile -> ChatResponse
CRUserProfile User
user (LocalProfile -> Profile
fromLocalProfile LocalProfile
profile)
  SetBotCommands [ChatBotCommand]
commands -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {LocalProfile
profile :: User -> LocalProfile
profile :: LocalProfile
profile} -> do
    let LocalProfile {Maybe Preferences
preferences :: Maybe Preferences
preferences :: LocalProfile -> Maybe Preferences
preferences} = LocalProfile
profile
        prefs :: Maybe Preferences
prefs = Preferences -> Maybe Preferences
forall a. a -> Maybe a
Just (Preferences -> Maybe Preferences -> Preferences
forall a. a -> Maybe a -> a
fromMaybe Preferences
emptyChatPrefs Maybe Preferences
preferences :: Preferences) {commands = Just commands}
        p :: Profile
p = (LocalProfile -> Profile
fromLocalProfile LocalProfile
profile :: Profile) {preferences = prefs, peerType = Just CPTBot}
    User -> Profile -> CM ChatResponse
updateProfile User
user Profile
p
  UpdateProfile Text
displayName Maybe Text
shortDescr -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {LocalProfile
profile :: User -> LocalProfile
profile :: LocalProfile
profile} -> do
    let p :: Profile
p = (LocalProfile -> Profile
fromLocalProfile LocalProfile
profile :: Profile) {displayName, shortDescr, fullName = ""}
    User -> Profile -> CM ChatResponse
updateProfile User
user Profile
p
  UpdateProfileImage Maybe ImageData
image -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {LocalProfile
profile :: User -> LocalProfile
profile :: LocalProfile
profile} -> do
    let p :: Profile
p = (LocalProfile -> Profile
fromLocalProfile LocalProfile
profile :: Profile) {image}
    User -> Profile -> CM ChatResponse
updateProfile User
user Profile
p
  ChatCommand
ShowProfileImage -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {LocalProfile
profile :: User -> LocalProfile
profile :: LocalProfile
profile} -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Profile -> ChatResponse
CRUserProfileImage User
user (Profile -> ChatResponse) -> Profile -> ChatResponse
forall a b. (a -> b) -> a -> b
$ LocalProfile -> Profile
fromLocalProfile LocalProfile
profile
  SetUserFeature (ACF SChatFeature f
f) FeatureAllowed
allowed -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {LocalProfile
profile :: User -> LocalProfile
profile :: LocalProfile
profile} -> do
    let p :: Profile
p = (LocalProfile -> Profile
fromLocalProfile LocalProfile
profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user}
    User -> Profile -> CM ChatResponse
updateProfile User
user Profile
p
  SetContactFeature (ACF SChatFeature f
f) Text
cName Maybe FeatureAllowed
allowed_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {Preferences
userPreferences :: Preferences
userPreferences :: Contact -> Preferences
userPreferences} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Text
-> ExceptT StoreError IO Contact
getContactByName Connection
db VersionRangeChat
vr User
user Text
cName
    let prefs' :: Preferences
prefs' = SChatFeature f
-> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f
-> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
setPreference SChatFeature f
f Maybe FeatureAllowed
allowed_ (Maybe Preferences -> Preferences)
-> Maybe Preferences -> Preferences
forall a b. (a -> b) -> a -> b
$ Preferences -> Maybe Preferences
forall a. a -> Maybe a
Just Preferences
userPreferences
    User -> Contact -> Preferences -> CM ChatResponse
updateContactPrefs User
user Contact
ct Preferences
prefs'
  SetGroupFeature (AGFNR SGroupFeature f
f) Text
gName GroupFeatureEnabled
enabled ->
    Text -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName Text
gName ((GroupProfile -> GroupProfile) -> CM ChatResponse)
-> (GroupProfile -> GroupProfile) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \GroupProfile
p ->
      GroupProfile
p {groupPreferences = Just . setGroupPreference f enabled $ groupPreferences p}
  SetGroupFeatureRole (AGFR SGroupFeature f
f) Text
gName GroupFeatureEnabled
enabled Maybe GroupMemberRole
role ->
    Text -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName Text
gName ((GroupProfile -> GroupProfile) -> CM ChatResponse)
-> (GroupProfile -> GroupProfile) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \GroupProfile
p ->
      GroupProfile
p {groupPreferences = Just . setGroupPreferenceRole f enabled role $ groupPreferences p}
  SetGroupMemberAdmissionReview Text
gName Maybe MemberCriteria
reviewAdmissionApplication ->
    Text -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName Text
gName ((GroupProfile -> GroupProfile) -> CM ChatResponse)
-> (GroupProfile -> GroupProfile) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \p :: GroupProfile
p@GroupProfile {Maybe GroupMemberAdmission
memberAdmission :: GroupProfile -> Maybe GroupMemberAdmission
memberAdmission :: Maybe GroupMemberAdmission
memberAdmission} ->
      case Maybe GroupMemberAdmission
memberAdmission of
        Maybe GroupMemberAdmission
Nothing -> GroupProfile
p {memberAdmission = Just (emptyGroupMemberAdmission :: GroupMemberAdmission) {review = reviewAdmissionApplication}}
        Just GroupMemberAdmission
ma -> GroupProfile
p {memberAdmission = Just (ma :: GroupMemberAdmission) {review = reviewAdmissionApplication}}
  SetUserTimedMessages Bool
onOff -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \user :: User
user@User {LocalProfile
profile :: User -> LocalProfile
profile :: LocalProfile
profile} -> do
    let allowed :: FeatureAllowed
allowed = if Bool
onOff then FeatureAllowed
FAYes else FeatureAllowed
FANo
        pref :: TimedMessagesPreference
pref = FeatureAllowed -> Maybe Int -> TimedMessagesPreference
TimedMessagesPreference FeatureAllowed
allowed Maybe Int
forall a. Maybe a
Nothing
        p :: Profile
p = (LocalProfile -> Profile
fromLocalProfile LocalProfile
profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user}
    User -> Profile -> CM ChatResponse
updateProfile User
user Profile
p
  SetContactTimedMessages Text
cName Maybe TimedMessagesEnabled
timedMessagesEnabled_ -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    ct :: Contact
ct@Contact {userPreferences :: Contact -> Preferences
userPreferences = userPreferences :: Preferences
userPreferences@Preferences {Maybe TimedMessagesPreference
timedMessages :: Maybe TimedMessagesPreference
timedMessages :: Preferences -> Maybe TimedMessagesPreference
timedMessages}} <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Text
-> ExceptT StoreError IO Contact
getContactByName Connection
db VersionRangeChat
vr User
user Text
cName
    let currentTTL :: Maybe Int
currentTTL = Maybe TimedMessagesPreference
timedMessages Maybe TimedMessagesPreference
-> (TimedMessagesPreference -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TimedMessagesPreference {Maybe Int
ttl :: Maybe Int
ttl :: TimedMessagesPreference -> Maybe Int
ttl} -> Maybe Int
ttl
        pref_ :: Maybe TimedMessagesPreference
pref_ = Maybe Int -> TimedMessagesEnabled -> TimedMessagesPreference
tmeToPref Maybe Int
currentTTL (TimedMessagesEnabled -> TimedMessagesPreference)
-> Maybe TimedMessagesEnabled -> Maybe TimedMessagesPreference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TimedMessagesEnabled
timedMessagesEnabled_
        prefs' :: Preferences
prefs' = SChatFeature 'CFTimedMessages
-> Maybe (FeaturePreference 'CFTimedMessages)
-> Maybe Preferences
-> Preferences
forall (f :: ChatFeature).
SChatFeature f
-> Maybe (FeaturePreference f) -> Maybe Preferences -> Preferences
setPreference' SChatFeature 'CFTimedMessages
SCFTimedMessages Maybe (FeaturePreference 'CFTimedMessages)
Maybe TimedMessagesPreference
pref_ (Maybe Preferences -> Preferences)
-> Maybe Preferences -> Preferences
forall a b. (a -> b) -> a -> b
$ Preferences -> Maybe Preferences
forall a. a -> Maybe a
Just Preferences
userPreferences
    User -> Contact -> Preferences -> CM ChatResponse
updateContactPrefs User
user Contact
ct Preferences
prefs'
  SetGroupTimedMessages Text
gName Maybe Int
ttl_ -> do
    let pref :: TimedMessagesGroupPreference
pref = (GroupFeatureEnabled -> Maybe Int -> TimedMessagesGroupPreference)
-> (GroupFeatureEnabled, Maybe Int) -> TimedMessagesGroupPreference
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry GroupFeatureEnabled -> Maybe Int -> TimedMessagesGroupPreference
TimedMessagesGroupPreference ((GroupFeatureEnabled, Maybe Int) -> TimedMessagesGroupPreference)
-> (GroupFeatureEnabled, Maybe Int) -> TimedMessagesGroupPreference
forall a b. (a -> b) -> a -> b
$ (GroupFeatureEnabled, Maybe Int)
-> (Int -> (GroupFeatureEnabled, Maybe Int))
-> Maybe Int
-> (GroupFeatureEnabled, Maybe Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (GroupFeatureEnabled
FEOff, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
86400) (\Int
ttl -> (GroupFeatureEnabled
FEOn, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ttl)) Maybe Int
ttl_
    Text -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName Text
gName ((GroupProfile -> GroupProfile) -> CM ChatResponse)
-> (GroupProfile -> GroupProfile) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \GroupProfile
p ->
      GroupProfile
p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
  SetLocalDeviceName Text
name -> (ChatController -> TVar Text)
-> Text -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar Text
localDeviceName Text
name ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ChatCommand
ListRemoteHosts -> [RemoteHostInfo] -> ChatResponse
CRRemoteHostList ([RemoteHostInfo] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [RemoteHostInfo]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT ChatError (ReaderT ChatController IO) [RemoteHostInfo]
listRemoteHosts
  SwitchRemoteHost Maybe Int64
rh_ -> Maybe RemoteHostInfo -> ChatResponse
CRCurrentRemoteHost (Maybe RemoteHostInfo -> ChatResponse)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe RemoteHostInfo)
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int64
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe RemoteHostInfo)
switchRemoteHost Maybe Int64
rh_
  StartRemoteHost Maybe (Int64, Bool)
rh_ Maybe RCCtrlAddress
ca_ Maybe Word16
bp_ -> do
    (NonEmpty RCCtrlAddress
localAddrs, Maybe RemoteHostInfo
remoteHost_, inv :: RCSignedInvitation
inv@RCSignedInvitation {invitation :: RCSignedInvitation -> RCInvitation
invitation = RCInvitation {Word16
port :: Word16
port :: RCInvitation -> Word16
port}}) <- Maybe (Int64, Bool)
-> Maybe RCCtrlAddress
-> Maybe Word16
-> CM
     (NonEmpty RCCtrlAddress, Maybe RemoteHostInfo, RCSignedInvitation)
startRemoteHost Maybe (Int64, Bool)
rh_ Maybe RCCtrlAddress
ca_ Maybe Word16
bp_
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRRemoteHostStarted {Maybe RemoteHostInfo
remoteHost_ :: Maybe RemoteHostInfo
remoteHost_ :: Maybe RemoteHostInfo
remoteHost_, invitation :: Text
invitation = ByteString -> Text
decodeLatin1 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ RCSignedInvitation -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode RCSignedInvitation
inv, ctrlPort :: String
ctrlPort = Word16 -> String
forall a. Show a => a -> String
show Word16
port, NonEmpty RCCtrlAddress
localAddrs :: NonEmpty RCCtrlAddress
localAddrs :: NonEmpty RCCtrlAddress
localAddrs}
  StopRemoteHost RHKey
rh_ -> RHKey -> ExceptT ChatError (ReaderT ChatController IO) ()
closeRemoteHost RHKey
rh_ ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  DeleteRemoteHost Int64
rh -> Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteRemoteHost Int64
rh ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  StoreRemoteFile Int64
rh Maybe Bool
encrypted_ String
localPath -> Int64 -> CryptoFile -> ChatResponse
CRRemoteFileStored Int64
rh (CryptoFile -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFile
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64
-> Maybe Bool
-> String
-> ExceptT ChatError (ReaderT ChatController IO) CryptoFile
storeRemoteFile Int64
rh Maybe Bool
encrypted_ String
localPath
  GetRemoteFile Int64
rh RemoteFile
rf -> Int64
-> RemoteFile -> ExceptT ChatError (ReaderT ChatController IO) ()
getRemoteFile Int64
rh RemoteFile
rf ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ConnectRemoteCtrl RCSignedInvitation
inv -> CM ChatResponse -> CM ChatResponse
withUser_ (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    (Maybe RemoteCtrlInfo
remoteCtrl_, CtrlAppInfo
ctrlAppInfo) <- RCSignedInvitation -> CM (Maybe RemoteCtrlInfo, CtrlAppInfo)
connectRemoteCtrlURI RCSignedInvitation
inv
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRRemoteCtrlConnecting {Maybe RemoteCtrlInfo
remoteCtrl_ :: Maybe RemoteCtrlInfo
remoteCtrl_ :: Maybe RemoteCtrlInfo
remoteCtrl_, CtrlAppInfo
ctrlAppInfo :: CtrlAppInfo
ctrlAppInfo :: CtrlAppInfo
ctrlAppInfo, appVersion :: AppVersion
appVersion = AppVersion
currentAppVersion}
  ChatCommand
FindKnownRemoteCtrl -> CM ChatResponse -> CM ChatResponse
withUser_ (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ExceptT ChatError (ReaderT ChatController IO) ()
findKnownRemoteCtrl ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ConfirmRemoteCtrl Int64
rcId -> CM ChatResponse -> CM ChatResponse
withUser_ (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    (RemoteCtrlInfo
rc, CtrlAppInfo
ctrlAppInfo) <- Int64 -> CM (RemoteCtrlInfo, CtrlAppInfo)
confirmRemoteCtrl Int64
rcId
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRRemoteCtrlConnecting {remoteCtrl_ :: Maybe RemoteCtrlInfo
remoteCtrl_ = RemoteCtrlInfo -> Maybe RemoteCtrlInfo
forall a. a -> Maybe a
Just RemoteCtrlInfo
rc, CtrlAppInfo
ctrlAppInfo :: CtrlAppInfo
ctrlAppInfo :: CtrlAppInfo
ctrlAppInfo, appVersion :: AppVersion
appVersion = AppVersion
currentAppVersion}
  VerifyRemoteCtrlSession Text
sessId -> CM ChatResponse -> CM ChatResponse
withUser_ (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ RemoteCtrlInfo -> ChatResponse
CRRemoteCtrlConnected (RemoteCtrlInfo -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) RemoteCtrlInfo
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Int -> CM' (Either ChatError ChatResponse))
-> Text
-> ExceptT ChatError (ReaderT ChatController IO) RemoteCtrlInfo
verifyRemoteCtrlSession (Maybe Int64
-> ByteString -> Int -> CM' (Either ChatError ChatResponse)
execChatCommand Maybe Int64
forall a. Maybe a
Nothing) Text
sessId
  ChatCommand
StopRemoteCtrl -> CM ChatResponse -> CM ChatResponse
withUser_ (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ExceptT ChatError (ReaderT ChatController IO) ()
stopRemoteCtrl ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ChatCommand
ListRemoteCtrls -> CM ChatResponse -> CM ChatResponse
withUser_ (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ [RemoteCtrlInfo] -> ChatResponse
CRRemoteCtrlList ([RemoteCtrlInfo] -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) [RemoteCtrlInfo]
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT ChatError (ReaderT ChatController IO) [RemoteCtrlInfo]
listRemoteCtrls
  DeleteRemoteCtrl Int64
rc -> CM ChatResponse -> CM ChatResponse
withUser_ (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteRemoteCtrl Int64
rc ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  APIUploadStandaloneFile Int64
userId file :: CryptoFile
file@CryptoFile {String
filePath :: CryptoFile -> String
filePath :: String
filePath} -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    String
fsFilePath <- ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO String
 -> ExceptT ChatError (ReaderT ChatController IO) String)
-> ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall a b. (a -> b) -> a -> b
$ String -> ReaderT ChatController IO String
toFSFilePath String
filePath
    Integer
fileSize <- IO Integer -> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer
 -> ExceptT ChatError (ReaderT ChatController IO) Integer)
-> IO Integer
-> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a b. (a -> b) -> a -> b
$ CryptoFile -> IO Integer
CF.getFileContentsSize CryptoFile
file {filePath = fsFilePath}
    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
fileSize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
maxFileSizeHard) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ChatErrorType
CEFileSize String
filePath
    (FileInvitation
_, CIFile 'MDSnd
_, FileTransferMeta
fileTransferMeta) <- User
-> CryptoFile
-> Integer
-> Int
-> Maybe ContactOrGroup
-> CM (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
xftpSndFileTransfer_ User
user CryptoFile
file Integer
fileSize Int
1 Maybe ContactOrGroup
forall a. Maybe a
Nothing
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRSndStandaloneFileCreated {User
user :: User
user :: User
user, FileTransferMeta
fileTransferMeta :: FileTransferMeta
fileTransferMeta :: FileTransferMeta
fileTransferMeta}
  APIStandaloneFileInfo FileDescriptionURI {Maybe Text
clientData :: Maybe Text
clientData :: FileDescriptionURI -> Maybe Text
clientData} -> ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> (Maybe Value -> ChatResponse) -> Maybe Value -> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> ChatResponse
CRStandaloneFileInfo (Maybe Value -> CM ChatResponse) -> Maybe Value -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Maybe Text
clientData Maybe Text -> (Text -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decodeStrict (ByteString -> Maybe Value)
-> (Text -> ByteString) -> Text -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
  APIDownloadStandaloneFile Int64
userId FileDescriptionURI
uri CryptoFile
file -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    RcvFileTransfer
ft <- User -> FileDescriptionURI -> CryptoFile -> CM RcvFileTransfer
receiveViaURI User
user FileDescriptionURI
uri CryptoFile
file
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> RcvFileTransfer -> ChatResponse
CRRcvStandaloneFileCreated User
user RcvFileTransfer
ft
  ChatCommand
QuitChat -> IO ChatResponse -> CM ChatResponse
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ChatResponse
forall a. IO a
exitSuccess
  ChatCommand
ShowVersion -> do
    -- simplexmqCommitQ makes iOS builds crash m(
    let versionInfo :: CoreVersionInfo
versionInfo = String -> CoreVersionInfo
coreVersionInfo String
""
    [UpMigration]
chatMigrations <- (Migration -> UpMigration) -> [Migration] -> [UpMigration]
forall a b. (a -> b) -> [a] -> [b]
map Migration -> UpMigration
upMigration ([Migration] -> [UpMigration])
-> ExceptT ChatError (ReaderT ChatController IO) [Migration]
-> ExceptT ChatError (ReaderT ChatController IO) [UpMigration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [Migration])
-> ExceptT ChatError (ReaderT ChatController IO) [Migration]
forall a. (Connection -> IO a) -> CM a
withFastStore' (Maybe Query -> Connection -> IO [Migration]
getCurrentMigrations Maybe Query
forall a. Maybe a
Nothing)
    [UpMigration]
agentMigrations <- (AgentClient -> ExceptT AgentErrorType IO [UpMigration])
-> ExceptT ChatError (ReaderT ChatController IO) [UpMigration]
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent AgentClient -> ExceptT AgentErrorType IO [UpMigration]
getAgentMigrations
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ CRVersionInfo {CoreVersionInfo
versionInfo :: CoreVersionInfo
versionInfo :: CoreVersionInfo
versionInfo, [UpMigration]
chatMigrations :: [UpMigration]
chatMigrations :: [UpMigration]
chatMigrations, [UpMigration]
agentMigrations :: [UpMigration]
agentMigrations :: [UpMigration]
agentMigrations}
  ChatCommand
DebugLocks -> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
chatLockName <- STM (Maybe Text) -> ReaderT ChatController IO (Maybe Text)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe Text) -> ReaderT ChatController IO (Maybe Text))
-> (TMVar Text -> STM (Maybe Text))
-> TMVar Text
-> ReaderT ChatController IO (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar Text -> STM (Maybe Text)
forall a. TMVar a -> STM (Maybe a)
tryReadTMVar (TMVar Text -> ReaderT ChatController IO (Maybe Text))
-> ReaderT ChatController IO (TMVar Text)
-> ReaderT ChatController IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ChatController -> TMVar Text)
-> ReaderT ChatController IO (TMVar Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMVar Text
chatLock
    Map Text Text
chatEntityLocks <- TVar (Map ChatLockEntity (TMVar Text))
-> ReaderT ChatController IO (Map Text Text)
forall {m :: * -> *} {a}.
MonadIO m =>
TVar (Map ChatLockEntity (TMVar a)) -> m (Map Text a)
getLocks (TVar (Map ChatLockEntity (TMVar Text))
 -> ReaderT ChatController IO (Map Text Text))
-> ReaderT
     ChatController IO (TVar (Map ChatLockEntity (TMVar Text)))
-> ReaderT ChatController IO (Map Text Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ChatController -> TVar (Map ChatLockEntity (TMVar Text)))
-> ReaderT
     ChatController IO (TVar (Map ChatLockEntity (TMVar Text)))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Map ChatLockEntity (TMVar Text))
entityLocks
    AgentLocks
agentLocks <- (AgentClient -> IO AgentLocks) -> CM' AgentLocks
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO AgentLocks
debugAgentLocks
    ChatResponse -> ReaderT ChatController IO ChatResponse
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CRDebugLocks {Maybe Text
chatLockName :: Maybe Text
chatLockName :: Maybe Text
chatLockName, Map Text Text
chatEntityLocks :: Map Text Text
chatEntityLocks :: Map Text Text
chatEntityLocks, AgentLocks
agentLocks :: AgentLocks
agentLocks :: AgentLocks
agentLocks}
    where
      getLocks :: TVar (Map ChatLockEntity (TMVar a)) -> m (Map Text a)
getLocks TVar (Map ChatLockEntity (TMVar a))
ls = STM (Map Text a) -> m (Map Text a)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Map Text a) -> m (Map Text a))
-> STM (Map Text a) -> m (Map Text a)
forall a b. (a -> b) -> a -> b
$ (ChatLockEntity -> Text) -> Map ChatLockEntity a -> Map Text a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys ChatLockEntity -> Text
enityLockString (Map ChatLockEntity a -> Map Text a)
-> (Map ChatLockEntity (Maybe a) -> Map ChatLockEntity a)
-> Map ChatLockEntity (Maybe a)
-> Map Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Maybe a)
-> Map ChatLockEntity (Maybe a) -> Map ChatLockEntity a
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Maybe a -> Maybe a
forall a. a -> a
id (Map ChatLockEntity (Maybe a) -> Map Text a)
-> STM (Map ChatLockEntity (Maybe a)) -> STM (Map Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((TMVar a -> STM (Maybe a))
-> Map ChatLockEntity (TMVar a)
-> STM (Map ChatLockEntity (Maybe a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Map ChatLockEntity a -> m (Map ChatLockEntity b)
mapM TMVar a -> STM (Maybe a)
forall a. TMVar a -> STM (Maybe a)
tryReadTMVar (Map ChatLockEntity (TMVar a)
 -> STM (Map ChatLockEntity (Maybe a)))
-> STM (Map ChatLockEntity (TMVar a))
-> STM (Map ChatLockEntity (Maybe a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar (Map ChatLockEntity (TMVar a))
-> STM (Map ChatLockEntity (TMVar a))
forall a. TVar a -> STM a
readTVar TVar (Map ChatLockEntity (TMVar a))
ls)
      enityLockString :: ChatLockEntity -> Text
enityLockString ChatLockEntity
cle = case ChatLockEntity
cle of
        CLInvitation ByteString
bs -> Text
"Invitation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
safeDecodeUtf8 ByteString
bs
        CLConnection Int64
connId -> Text
"Connection " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
connId
        CLContact Int64
ctId -> Text
"Contact " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
ctId
        CLGroup Int64
gId -> Text
"Group " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
gId
        CLUserContact Int64
ucId -> Text
"UserContact " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
ucId
        CLContactRequest Int64
crId -> Text
"ContactRequest " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
crId
        CLFile Int64
fId -> Text
"File " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
fId
  DebugEvent ChatEvent
event -> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView ChatEvent
event ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  GetAgentSubsTotal Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [User])
 -> ExceptT ChatError (ReaderT ChatController IO) [User])
-> (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> IO [User]
getUsers Connection
db
    let userIds :: [Int64]
userIds = (User -> Int64) -> [User] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map User -> Int64
aUserId ([User] -> [Int64]) -> [User] -> [Int64]
forall a b. (a -> b) -> a -> b
$ (User -> Bool) -> [User] -> [User]
forall a. (a -> Bool) -> [a] -> [a]
filter (\User
u -> Maybe UserPwdHash -> Bool
forall a. Maybe a -> Bool
isNothing (User -> Maybe UserPwdHash
viewPwdHash User
u) Bool -> Bool -> Bool
|| User -> Int64
aUserId User
u Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== User -> Int64
aUserId User
user) [User]
users
    (SMPServerSubs
subsTotal, Bool
hasSession) <- ReaderT ChatController IO (SMPServerSubs, Bool)
-> ExceptT
     ChatError (ReaderT ChatController IO) (SMPServerSubs, Bool)
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO (SMPServerSubs, Bool)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (SMPServerSubs, Bool))
-> ReaderT ChatController IO (SMPServerSubs, Bool)
-> ExceptT
     ChatError (ReaderT ChatController IO) (SMPServerSubs, Bool)
forall a b. (a -> b) -> a -> b
$ (AgentClient -> IO (SMPServerSubs, Bool))
-> ReaderT ChatController IO (SMPServerSubs, Bool)
forall a. (AgentClient -> IO a) -> CM' a
withAgent' ((AgentClient -> IO (SMPServerSubs, Bool))
 -> ReaderT ChatController IO (SMPServerSubs, Bool))
-> (AgentClient -> IO (SMPServerSubs, Bool))
-> ReaderT ChatController IO (SMPServerSubs, Bool)
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient -> [Int64] -> IO (SMPServerSubs, Bool)
getAgentSubsTotal AgentClient
a [Int64]
userIds
    ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> SMPServerSubs -> Bool -> ChatResponse
CRAgentSubsTotal User
user SMPServerSubs
subsTotal Bool
hasSession
  GetAgentServersSummary Int64
userId -> Int64 -> (User -> CM ChatResponse) -> CM ChatResponse
withUserId Int64
userId ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
    AgentServersSummary
agentServersSummary <- ReaderT ChatController IO AgentServersSummary
-> ExceptT
     ChatError (ReaderT ChatController IO) AgentServersSummary
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO AgentServersSummary
 -> ExceptT
      ChatError (ReaderT ChatController IO) AgentServersSummary)
-> ReaderT ChatController IO AgentServersSummary
-> ExceptT
     ChatError (ReaderT ChatController IO) AgentServersSummary
forall a b. (a -> b) -> a -> b
$ (AgentClient -> IO AgentServersSummary)
-> ReaderT ChatController IO AgentServersSummary
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO AgentServersSummary
getAgentServersSummary
    (Connection -> IO ChatResponse) -> CM ChatResponse
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO ChatResponse) -> CM ChatResponse)
-> (Connection -> IO ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      [User]
users <- Connection -> IO [User]
getUsers Connection
db
      [SMPServer]
smpServers <- Connection -> User -> SProtocolType 'PSMP -> IO [SMPServer]
forall (p :: ProtocolType).
ProtocolTypeI p =>
Connection -> User -> SProtocolType p -> IO [ProtocolServer p]
getServers Connection
db User
user SProtocolType 'PSMP
SPSMP
      [ProtocolServer 'PXFTP]
xftpServers <- Connection
-> User -> SProtocolType 'PXFTP -> IO [ProtocolServer 'PXFTP]
forall (p :: ProtocolType).
ProtocolTypeI p =>
Connection -> User -> SProtocolType p -> IO [ProtocolServer p]
getServers Connection
db User
user SProtocolType 'PXFTP
SPXFTP
      let presentedServersSummary :: PresentedServersSummary
presentedServersSummary = AgentServersSummary
-> [User]
-> User
-> [SMPServer]
-> [ProtocolServer 'PXFTP]
-> [NtfServer]
-> PresentedServersSummary
toPresentedServersSummary AgentServersSummary
agentServersSummary [User]
users User
user [SMPServer]
smpServers [ProtocolServer 'PXFTP]
xftpServers [NtfServer]
_defaultNtfServers
      ChatResponse -> IO ChatResponse
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> IO ChatResponse)
-> ChatResponse -> IO ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> PresentedServersSummary -> ChatResponse
CRAgentServersSummary User
user PresentedServersSummary
presentedServersSummary
    where
      getServers :: ProtocolTypeI p => DB.Connection -> User -> SProtocolType p -> IO [ProtocolServer p]
      getServers :: forall (p :: ProtocolType).
ProtocolTypeI p =>
Connection -> User -> SProtocolType p -> IO [ProtocolServer p]
getServers Connection
db User
user SProtocolType p
p = (UserServer' 'DBStored p -> ProtocolServer p)
-> [UserServer' 'DBStored p] -> [ProtocolServer p]
forall a b. (a -> b) -> [a] -> [b]
map (\UserServer {ProtoServerWithAuth p
server :: ProtoServerWithAuth p
server :: forall (s :: DBStored) (p :: ProtocolType).
UserServer' s p -> ProtoServerWithAuth p
server} -> ProtoServerWithAuth p -> ProtocolServer p
forall (p :: ProtocolType).
ProtoServerWithAuth p -> ProtocolServer p
protoServer ProtoServerWithAuth p
server) ([UserServer' 'DBStored p] -> [ProtocolServer p])
-> IO [UserServer' 'DBStored p] -> IO [ProtocolServer p]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> SProtocolType p -> User -> IO [UserServer' 'DBStored p]
forall (p :: ProtocolType).
ProtocolTypeI p =>
Connection -> SProtocolType p -> User -> IO [UserServer p]
getProtocolServers Connection
db SProtocolType p
p User
user
  ChatCommand
ResetAgentServersStats -> (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent AgentClient -> ExceptT AgentErrorType IO ()
resetAgentServersStats ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
  ChatCommand
GetAgentWorkers -> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ AgentWorkersSummary -> ChatResponse
CRAgentWorkersSummary (AgentWorkersSummary -> ChatResponse)
-> ReaderT ChatController IO AgentWorkersSummary
-> ReaderT ChatController IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> IO AgentWorkersSummary)
-> ReaderT ChatController IO AgentWorkersSummary
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO AgentWorkersSummary
getAgentWorkersSummary
  ChatCommand
GetAgentWorkersDetails -> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ AgentWorkersDetails -> ChatResponse
CRAgentWorkersDetails (AgentWorkersDetails -> ChatResponse)
-> ReaderT ChatController IO AgentWorkersDetails
-> ReaderT ChatController IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> IO AgentWorkersDetails)
-> ReaderT ChatController IO AgentWorkersDetails
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO AgentWorkersDetails
getAgentWorkersDetails
  ChatCommand
GetAgentSubs -> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SubscriptionsInfo -> ChatResponse
summary (SubscriptionsInfo -> ChatResponse)
-> ReaderT ChatController IO SubscriptionsInfo
-> ReaderT ChatController IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> IO SubscriptionsInfo)
-> ReaderT ChatController IO SubscriptionsInfo
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO SubscriptionsInfo
getAgentSubscriptions
    where
      summary :: SubscriptionsInfo -> ChatResponse
summary SubscriptionsInfo {[SubInfo]
activeSubscriptions :: [SubInfo]
activeSubscriptions :: SubscriptionsInfo -> [SubInfo]
activeSubscriptions, [SubInfo]
pendingSubscriptions :: [SubInfo]
pendingSubscriptions :: SubscriptionsInfo -> [SubInfo]
pendingSubscriptions, [SubInfo]
removedSubscriptions :: [SubInfo]
removedSubscriptions :: SubscriptionsInfo -> [SubInfo]
removedSubscriptions} =
        CRAgentSubs
          { activeSubs :: Map Text Int
activeSubs = (Map Text Int -> SubInfo -> Map Text Int)
-> Map Text Int -> [SubInfo] -> Map Text Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Text Int -> SubInfo -> Map Text Int
forall {a}. Num a => Map Text a -> SubInfo -> Map Text a
countSubs Map Text Int
forall k a. Map k a
M.empty [SubInfo]
activeSubscriptions,
            pendingSubs :: Map Text Int
pendingSubs = (Map Text Int -> SubInfo -> Map Text Int)
-> Map Text Int -> [SubInfo] -> Map Text Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Text Int -> SubInfo -> Map Text Int
forall {a}. Num a => Map Text a -> SubInfo -> Map Text a
countSubs Map Text Int
forall k a. Map k a
M.empty [SubInfo]
pendingSubscriptions,
            removedSubs :: Map Text [String]
removedSubs = (Map Text [String] -> SubInfo -> Map Text [String])
-> Map Text [String] -> [SubInfo] -> Map Text [String]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Text [String] -> SubInfo -> Map Text [String]
accSubErrors Map Text [String]
forall k a. Map k a
M.empty [SubInfo]
removedSubscriptions
          }
        where
          countSubs :: Map Text a -> SubInfo -> Map Text a
countSubs Map Text a
m SubInfo {Text
server :: Text
server :: SubInfo -> Text
server} = (Maybe a -> Maybe a) -> Text -> Map Text a -> Map Text a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Maybe a -> a) -> Maybe a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
1 (a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)) Text
server Map Text a
m
          accSubErrors :: Map Text [String] -> SubInfo -> Map Text [String]
accSubErrors Map Text [String]
m = \case
            SubInfo {Text
server :: SubInfo -> Text
server :: Text
server, subError :: SubInfo -> Maybe String
subError = Just String
e} -> (Maybe [String] -> Maybe [String])
-> Text -> Map Text [String] -> Map Text [String]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter ([String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String])
-> (Maybe [String] -> [String]) -> Maybe [String] -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ([String] -> [String]) -> Maybe [String] -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String
Item [String]
e] (String
e String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)) Text
server Map Text [String]
m
            SubInfo
_ -> Map Text [String]
m
  ChatCommand
GetAgentSubsDetails -> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ SubscriptionsInfo -> ChatResponse
CRAgentSubsDetails (SubscriptionsInfo -> ChatResponse)
-> ReaderT ChatController IO SubscriptionsInfo
-> ReaderT ChatController IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> IO SubscriptionsInfo)
-> ReaderT ChatController IO SubscriptionsInfo
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO SubscriptionsInfo
getAgentSubscriptions
  ChatCommand
GetAgentQueuesInfo -> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ChatResponse -> CM ChatResponse)
-> ReaderT ChatController IO ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ AgentQueuesInfo -> ChatResponse
CRAgentQueuesInfo (AgentQueuesInfo -> ChatResponse)
-> ReaderT ChatController IO AgentQueuesInfo
-> ReaderT ChatController IO ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> IO AgentQueuesInfo)
-> ReaderT ChatController IO AgentQueuesInfo
forall a. (AgentClient -> IO a) -> CM' a
withAgent' AgentClient -> IO AgentQueuesInfo
getAgentQueuesInfo
  -- CustomChatCommand is unsupported, it can be processed in preCmdHook
  -- in a modified CLI app or core - the hook should return Either (Either ChatError ChatResponse) ChatCommand,
  -- where Left means command result, and Right – some other command to be processed by this function.
  CustomChatCommand ByteString
_cmd -> (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
  where
    ok_ :: CM ChatResponse
ok_ = ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Maybe User -> ChatResponse
CRCmdOk Maybe User
forall a. Maybe a
Nothing
    ok :: User -> CM ChatResponse
ok = ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> (User -> ChatResponse) -> User -> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe User -> ChatResponse
CRCmdOk (Maybe User -> ChatResponse)
-> (User -> Maybe User) -> User -> ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Maybe User
forall a. a -> Maybe a
Just
    getChatRef :: User -> ChatName -> CM ChatRef
    getChatRef :: User -> ChatName -> CM ChatRef
getChatRef User
user (ChatName ChatType
cType Text
name) = do
      Int64
chatId <- case ChatType
cType of
        ChatType
CTDirect -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
name
        ChatType
CTGroup -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
name
        ChatType
CTLocal
          | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> User -> ExceptT StoreError IO Int64
`getUserNoteFolderId` User
user)
          | Bool
otherwise -> String -> CM Int64
forall a. String -> CM a
throwCmdError String
"not supported"
        ChatType
_ -> String -> CM Int64
forall a. String -> CM a
throwCmdError String
"not supported"
      ChatRef -> CM ChatRef
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatRef -> CM ChatRef) -> ChatRef -> CM ChatRef
forall a b. (a -> b) -> a -> b
$ ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
forall a. Maybe a
Nothing
    getChatRefAndMentions :: User -> ChatName -> Text -> CM (ChatRef, Map MemberName GroupMemberId)
    getChatRefAndMentions :: User -> ChatName -> Text -> CM (ChatRef, Map Text Int64)
getChatRefAndMentions User
user ChatName
cName Text
msg = do
      chatRef :: ChatRef
chatRef@(ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
_) <- User -> ChatName -> CM ChatRef
getChatRef User
user ChatName
cName
      (ChatRef
chatRef,) (Map Text Int64 -> (ChatRef, Map Text Int64))
-> ExceptT ChatError (ReaderT ChatController IO) (Map Text Int64)
-> CM (ChatRef, Map Text Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ChatType
cType of
        ChatType
CTGroup -> (Connection -> IO (Map Text Int64))
-> ExceptT ChatError (ReaderT ChatController IO) (Map Text Int64)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (Map Text Int64))
 -> ExceptT ChatError (ReaderT ChatController IO) (Map Text Int64))
-> (Connection -> IO (Map Text Int64))
-> ExceptT ChatError (ReaderT ChatController IO) (Map Text Int64)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Text -> IO (Map Text Int64)
getMessageMentions Connection
db User
user Int64
chatId Text
msg
        ChatType
_ -> Map Text Int64
-> ExceptT ChatError (ReaderT ChatController IO) (Map Text Int64)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
#if !defined(dbPostgres)
    checkChatStopped :: CM ChatResponse -> CM ChatResponse
    checkChatStopped :: CM ChatResponse -> CM ChatResponse
checkChatStopped CM ChatResponse
a = (ChatController -> TVar (Maybe (Async (), Maybe (Async ()))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (TVar (Maybe (Async (), Maybe (Async ()))))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe (Async (), Maybe (Async ())))
agentAsync ExceptT
  ChatError
  (ReaderT ChatController IO)
  (TVar (Maybe (Async (), Maybe (Async ()))))
-> (TVar (Maybe (Async (), Maybe (Async ())))
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe (Async (), Maybe (Async ()))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (Async (), Maybe (Async ())))
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar (Maybe (Async (), Maybe (Async ())))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (Async (), Maybe (Async ())))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Maybe (Async (), Maybe (Async ())))
-> (Maybe (Async (), Maybe (Async ())) -> CM ChatResponse)
-> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CM ChatResponse
-> ((Async (), Maybe (Async ())) -> CM ChatResponse)
-> Maybe (Async (), Maybe (Async ()))
-> CM ChatResponse
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CM ChatResponse
a (CM ChatResponse -> (Async (), Maybe (Async ())) -> CM ChatResponse
forall a b. a -> b -> a
const (CM ChatResponse
 -> (Async (), Maybe (Async ())) -> CM ChatResponse)
-> CM ChatResponse
-> (Async (), Maybe (Async ()))
-> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEChatNotStopped)
    setStoreChanged :: CM ()
    setStoreChanged :: ExceptT ChatError (ReaderT ChatController IO) ()
setStoreChanged = (ChatController -> TVar Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar Bool
chatStoreChanged ExceptT ChatError (ReaderT ChatController IO) (TVar Bool)
-> (TVar Bool -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (TVar Bool -> STM ())
-> TVar Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
`writeTVar` Bool
True)
    withStoreChanged :: CM () -> CM ChatResponse
    withStoreChanged :: ExceptT ChatError (ReaderT ChatController IO) () -> CM ChatResponse
withStoreChanged ExceptT ChatError (ReaderT ChatController IO) ()
a = CM ChatResponse -> CM ChatResponse
checkChatStopped (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ExceptT ChatError (ReaderT ChatController IO) ()
a ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExceptT ChatError (ReaderT ChatController IO) ()
setStoreChanged ExceptT ChatError (ReaderT ChatController IO) ()
-> CM ChatResponse -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CM ChatResponse
ok_
#endif
    checkStoreNotChanged :: CM ChatResponse -> CM ChatResponse
    checkStoreNotChanged :: CM ChatResponse -> CM ChatResponse
checkStoreNotChanged = ExceptT ChatError (ReaderT ChatController IO) Bool
-> CM ChatResponse -> CM ChatResponse -> CM ChatResponse
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ((ChatController -> TVar Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar Bool
chatStoreChanged ExceptT ChatError (ReaderT ChatController IO) (TVar Bool)
-> (TVar Bool
    -> ExceptT ChatError (ReaderT ChatController IO) Bool)
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar Bool -> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO) (ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEChatStoreChanged)
    withUserName :: UserName -> (UserId -> ChatCommand) -> CM ChatResponse
    withUserName :: Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withUserName Text
uName Int64 -> ChatCommand
cmd = (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (Connection -> Text -> ExceptT StoreError IO Int64
`getUserIdByName` Text
uName) CM Int64 -> (Int64 -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse)
-> (Int64 -> ChatCommand) -> Int64 -> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ChatCommand
cmd
    withContactName :: ContactName -> (ContactId -> ChatCommand) -> CM ChatResponse
    withContactName :: Text -> (Int64 -> ChatCommand) -> CM ChatResponse
withContactName Text
cName Int64 -> ChatCommand
cmd = (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
      (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore (\Connection
db -> Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
cName) CM Int64 -> (Int64 -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse)
-> (Int64 -> ChatCommand) -> Int64 -> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ChatCommand
cmd
    withMemberName :: GroupName -> ContactName -> (GroupId -> GroupMemberId -> ChatCommand) -> CM ChatResponse
    withMemberName :: Text -> Text -> (Int64 -> Int64 -> ChatCommand) -> CM ChatResponse
withMemberName Text
gName Text
mName Int64 -> Int64 -> ChatCommand
cmd = (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user ->
      User -> Text -> Text -> CM (Int64, Int64)
getGroupAndMemberId User
user Text
gName Text
mName CM (Int64, Int64)
-> ((Int64, Int64) -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse)
-> ((Int64, Int64) -> ChatCommand)
-> (Int64, Int64)
-> CM ChatResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> ChatCommand) -> (Int64, Int64) -> ChatCommand
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int64 -> Int64 -> ChatCommand
cmd
    getConnectionCode :: ConnId -> CM Text
    getConnectionCode :: ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
getConnectionCode ByteString
connId = ByteString -> Text
verificationCode (ByteString -> Text)
-> CM ByteString
-> ExceptT ChatError (ReaderT ChatController IO) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (AgentClient -> ByteString -> ExceptT AgentErrorType IO ByteString
`getConnectionRatchetAdHash` ByteString
connId)
    verifyConnectionCode :: User -> Connection -> Maybe Text -> CM ChatResponse
    verifyConnectionCode :: User -> Connection -> Maybe Text -> CM ChatResponse
verifyConnectionCode User
user conn :: Connection
conn@Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} (Just Text
code) = do
      Text
code' <- ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
getConnectionCode (ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text)
-> ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
aConnId Connection
conn
      let verified :: Bool
verified = Text -> Text -> Bool
sameVerificationCode Text
code Text
code'
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verified (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ((Connection -> IO ())
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Maybe Text -> IO ()
setConnectionVerified Connection
db User
user Int64
connId (Maybe Text -> IO ()) -> Maybe Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
code'
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Bool -> Text -> ChatResponse
CRConnectionVerified User
user Bool
verified Text
code'
    verifyConnectionCode User
user conn :: Connection
conn@Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId} Maybe Text
_ = do
      Text
code' <- ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
getConnectionCode (ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text)
-> ByteString -> ExceptT ChatError (ReaderT ChatController IO) Text
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
aConnId Connection
conn
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Maybe Text -> IO ()
setConnectionVerified Connection
db User
user Int64
connId Maybe Text
forall a. Maybe a
Nothing
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Bool -> Text -> ChatResponse
CRConnectionVerified User
user Bool
False Text
code'
    getSentChatItemIdByText :: User -> ChatRef -> Text -> CM Int64
    getSentChatItemIdByText :: User -> ChatRef -> Text -> CM Int64
getSentChatItemIdByText user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId, Text
localDisplayName :: User -> Text
localDisplayName :: Text
localDisplayName} (ChatRef ChatType
cType Int64
cId Maybe GroupChatScope
_scope) Text
msg = case ChatType
cType of
      ChatType
CTDirect -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64
-> Int64
-> SMsgDirection 'MDSnd
-> Text
-> ExceptT StoreError IO Int64
forall (d :: MsgDirection).
Connection
-> Int64
-> Int64
-> SMsgDirection d
-> Text
-> ExceptT StoreError IO Int64
getDirectChatItemIdByText Connection
db Int64
userId Int64
cId SMsgDirection 'MDSnd
SMDSnd Text
msg
      ChatType
CTGroup -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> Int64
-> Maybe Text
-> Text
-> ExceptT StoreError IO Int64
getGroupChatItemIdByText Connection
db User
user Int64
cId (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
localDisplayName) Text
msg
      ChatType
CTLocal -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> Int64
-> SMsgDirection 'MDSnd
-> Text
-> ExceptT StoreError IO Int64
forall (d :: MsgDirection).
Connection
-> User
-> Int64
-> SMsgDirection d
-> Text
-> ExceptT StoreError IO Int64
getLocalChatItemIdByText Connection
db User
user Int64
cId SMsgDirection 'MDSnd
SMDSnd Text
msg
      ChatType
_ -> String -> CM Int64
forall a. String -> CM a
throwCmdError String
"not supported"
    getChatItemIdByText :: User -> ChatRef -> Text -> CM Int64
    getChatItemIdByText :: User -> ChatRef -> Text -> CM Int64
getChatItemIdByText User
user (ChatRef ChatType
cType Int64
cId Maybe GroupChatScope
_scope) Text
msg = case ChatType
cType of
      ChatType
CTDirect -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getDirectChatItemIdByText' Connection
db User
user Int64
cId Text
msg
      ChatType
CTGroup -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getGroupChatItemIdByText' Connection
db User
user Int64
cId Text
msg
      ChatType
CTLocal -> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Int64) -> CM Int64)
-> (Connection -> ExceptT StoreError IO Int64) -> CM Int64
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getLocalChatItemIdByText' Connection
db User
user Int64
cId Text
msg
      ChatType
_ -> String -> CM Int64
forall a. String -> CM a
throwCmdError String
"not supported"
    connectViaInvitation :: User -> IncognitoEnabled -> CreatedLinkInvitation -> Maybe ContactId -> CM (Connection, Maybe Profile)
    connectViaInvitation :: User
-> Bool
-> CreatedConnLink 'CMInvitation
-> Maybe Int64
-> CM (Connection, Maybe Profile)
connectViaInvitation user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Bool
incognito (CCLink cReq :: ConnReqInvitation
cReq@(CRInvitationUri ConnReqUriData
crData RcvE2ERatchetParamsUri 'X448
e2e) Maybe ShortLinkInvitation
sLnk_) Maybe Int64
contactId_ =
      Text
-> ByteString
-> CM (Connection, Maybe Profile)
-> CM (Connection, Maybe Profile)
forall a. Text -> ByteString -> CM a -> CM a
withInvitationLock Text
"connect" (ConnReqInvitation -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ConnReqInvitation
cReq) (CM (Connection, Maybe Profile) -> CM (Connection, Maybe Profile))
-> CM (Connection, Maybe Profile) -> CM (Connection, Maybe Profile)
forall a b. (a -> b) -> a -> b
$ do
        SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
        ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (VersionSMPA, PQSupport))
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((AgentClient -> IO (Maybe (VersionSMPA, PQSupport)))
-> ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport))
forall a. (AgentClient -> IO a) -> CM' a
withAgent' ((AgentClient -> IO (Maybe (VersionSMPA, PQSupport)))
 -> ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport)))
-> (AgentClient -> IO (Maybe (VersionSMPA, PQSupport)))
-> ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> PQSupport
-> ConnReqInvitation
-> IO (Maybe (VersionSMPA, PQSupport))
forall (c :: ConnectionMode).
AgentClient
-> PQSupport
-> ConnectionRequestUri c
-> IO (Maybe (VersionSMPA, PQSupport))
connRequestPQSupport AgentClient
a PQSupport
PQSupportOn ConnReqInvitation
cReq) ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Maybe (VersionSMPA, PQSupport))
-> (Maybe (VersionSMPA, PQSupport)
    -> CM (Connection, Maybe Profile))
-> CM (Connection, Maybe Profile)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe (VersionSMPA, PQSupport)
Nothing -> ChatErrorType -> CM (Connection, Maybe Profile)
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidConnReq
          -- TODO PQ the error above should be CEIncompatibleConnReqVersion, also the same API should be called in Plan
          Just (VersionSMPA
agentV, PQSupport
pqSup') -> do
            let chatV :: Version ChatVersion
chatV = VersionSMPA -> Version ChatVersion
agentToChatVersion VersionSMPA
agentV
            (Connection -> IO (Maybe ConnectionEntity))
-> CM (Maybe ConnectionEntity)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> (ConnReqInvitation, ConnReqInvitation)
-> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq Connection
db VersionRangeChat
vr User
user (ConnReqInvitation, ConnReqInvitation)
cReqs) CM (Maybe ConnectionEntity)
-> (Maybe ConnectionEntity -> CM (Connection, Maybe Profile))
-> CM (Connection, Maybe Profile)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe ConnectionEntity
Nothing -> Version ChatVersion -> CM (Connection, Maybe Profile)
joinNewConn Version ChatVersion
chatV
              Just (RcvDirectMsgConnection conn :: Connection
conn@Connection {ConnStatus
connStatus :: Connection -> ConnStatus
connStatus :: ConnStatus
connStatus, Bool
contactConnInitiated :: Bool
contactConnInitiated :: Connection -> Bool
contactConnInitiated, Maybe Int64
customUserProfileId :: Connection -> Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId} Maybe Contact
_ct_)
                | ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnNew Bool -> Bool -> Bool
&& Bool
contactConnInitiated -> Version ChatVersion -> CM (Connection, Maybe Profile)
joinNewConn Version ChatVersion
chatV -- own connection link
                | ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnPrepared -> do -- retrying join after error
                    Maybe LocalProfile
localIncognitoProfile <- Maybe Int64
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int64
customUserProfileId ((Int64
  -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe LocalProfile))
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall a b. (a -> b) -> a -> b
$ \Int64
pId -> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO LocalProfile)
 -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById Connection
db Int64
userId Int64
pId
                    Connection
-> Maybe Profile
-> Version ChatVersion
-> CM (Connection, Maybe Profile)
joinPreparedConn Connection
conn (LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> Maybe LocalProfile -> Maybe Profile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalProfile
localIncognitoProfile) Version ChatVersion
chatV
              Just ConnectionEntity
ent -> String -> CM (Connection, Maybe Profile)
forall a. String -> CM a
throwCmdError (String -> CM (Connection, Maybe Profile))
-> String -> CM (Connection, Maybe Profile)
forall a b. (a -> b) -> a -> b
$ String
"connection is not RcvDirectMsgConnection: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show (ConnectionEntity -> String
connEntityInfo ConnectionEntity
ent)
            where
              joinNewConn :: Version ChatVersion -> CM (Connection, Maybe Profile)
joinNewConn Version ChatVersion
chatV = do
                -- [incognito] generate profile to send
                Maybe Profile
incognitoProfile <- if Bool
incognito then Profile -> Maybe Profile
forall a. a -> Maybe a
Just (Profile -> Maybe Profile)
-> ExceptT ChatError (ReaderT ChatController IO) Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Profile -> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Profile
generateRandomProfile else Maybe Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Profile
forall a. Maybe a
Nothing
                ByteString
connId <- (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ByteString)
 -> CM ByteString)
-> (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> Int64
-> Bool
-> ConnReqInvitation
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
forall (c :: ConnectionMode).
AgentClient
-> Int64
-> Bool
-> ConnectionRequestUri c
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
prepareConnectionToJoin AgentClient
a (User -> Int64
aUserId User
user) Bool
True ConnReqInvitation
cReq PQSupport
pqSup'
                let ccLink :: CreatedConnLink 'CMInvitation
ccLink = ConnReqInvitation
-> Maybe ShortLinkInvitation -> CreatedConnLink 'CMInvitation
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqInvitation
cReq (Maybe ShortLinkInvitation -> CreatedConnLink 'CMInvitation)
-> Maybe ShortLinkInvitation -> CreatedConnLink 'CMInvitation
forall a b. (a -> b) -> a -> b
$ ShortLinkInvitation -> ShortLinkInvitation
forall (m :: ConnectionMode). ConnShortLink m -> ConnShortLink m
serverShortLink (ShortLinkInvitation -> ShortLinkInvitation)
-> Maybe ShortLinkInvitation -> Maybe ShortLinkInvitation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ShortLinkInvitation
sLnk_
                Connection
conn <- (Connection -> IO Connection) -> CM Connection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Connection) -> CM Connection)
-> (Connection -> IO Connection) -> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64
-> ByteString
-> CreatedConnLink 'CMInvitation
-> Maybe Int64
-> ConnStatus
-> Maybe Profile
-> SubscriptionMode
-> Version ChatVersion
-> PQSupport
-> IO Connection
createDirectConnection' Connection
db Int64
userId ByteString
connId CreatedConnLink 'CMInvitation
ccLink Maybe Int64
contactId_ ConnStatus
ConnPrepared Maybe Profile
incognitoProfile SubscriptionMode
subMode Version ChatVersion
chatV PQSupport
pqSup'
                Connection
-> Maybe Profile
-> Version ChatVersion
-> CM (Connection, Maybe Profile)
joinPreparedConn Connection
conn Maybe Profile
incognitoProfile Version ChatVersion
chatV
              joinPreparedConn :: Connection
-> Maybe Profile
-> Version ChatVersion
-> CM (Connection, Maybe Profile)
joinPreparedConn Connection
conn Maybe Profile
incognitoProfile Version ChatVersion
chatV = do
                let profileToSend :: Profile
profileToSend = User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user Maybe Profile
incognitoProfile Maybe Contact
forall a. Maybe a
Nothing Bool
True
                ByteString
dm <- PQSupport
-> Version ChatVersion -> ChatMsgEvent 'Json -> CM ByteString
forall (e :: MsgEncoding).
MsgEncodingI e =>
PQSupport -> Version ChatVersion -> ChatMsgEvent e -> CM ByteString
encodeConnInfoPQ PQSupport
pqSup' Version ChatVersion
chatV (ChatMsgEvent 'Json -> CM ByteString)
-> ChatMsgEvent 'Json -> CM ByteString
forall a b. (a -> b) -> a -> b
$ Profile -> ChatMsgEvent 'Json
XInfo Profile
profileToSend
                (Bool
sqSecured, Maybe (DBEntityId' 'DBStored)
_serviceId) <- (AgentClient
 -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Bool, Maybe (DBEntityId' 'DBStored)))
-> (AgentClient
    -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnReqInvitation
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
forall (c :: ConnectionMode).
AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnectionRequestUri c
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
joinConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) (Connection -> ByteString
aConnId Connection
conn) Bool
True ConnReqInvitation
cReq ByteString
dm PQSupport
pqSup' SubscriptionMode
subMode
                let newStatus :: ConnStatus
newStatus = if Bool
sqSecured then ConnStatus
ConnSndReady else ConnStatus
ConnJoined
                Connection
conn' <- (Connection -> IO Connection) -> CM Connection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Connection) -> CM Connection)
-> (Connection -> IO Connection) -> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Connection -> ConnStatus -> ConnStatus -> IO Connection
updateConnectionStatusFromTo Connection
db Connection
conn ConnStatus
ConnPrepared ConnStatus
newStatus
                (Connection, Maybe Profile) -> CM (Connection, Maybe Profile)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Connection
conn', Maybe Profile
incognitoProfile)
              cReqs :: (ConnReqInvitation, ConnReqInvitation)
cReqs =
                ( ConnReqUriData -> RcvE2ERatchetParamsUri 'X448 -> ConnReqInvitation
CRInvitationUri ConnReqUriData
crData {crScheme = SSSimplex} RcvE2ERatchetParamsUri 'X448
e2e,
                  ConnReqUriData -> RcvE2ERatchetParamsUri 'X448 -> ConnReqInvitation
CRInvitationUri ConnReqUriData
crData {crScheme = simplexChat} RcvE2ERatchetParamsUri 'X448
e2e
                )
    connectViaContact :: User -> Maybe PreparedChatEntity -> IncognitoEnabled -> CreatedLinkContact -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> CM ConnectViaContactResult
    connectViaContact :: User
-> Maybe PreparedChatEntity
-> Bool
-> CreatedLinkContact
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> CM ConnectViaContactResult
connectViaContact user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Maybe PreparedChatEntity
preparedEntity_ Bool
incognito (CCLink cReq :: ConnReqContact
cReq@(CRContactUri crData :: ConnReqUriData
crData@ConnReqUriData {Maybe Text
crClientData :: Maybe Text
crClientData :: ConnReqUriData -> Maybe Text
crClientData}) Maybe (ConnShortLink 'CMContact)
sLnk) Maybe SharedMsgId
welcomeSharedMsgId Maybe (SharedMsgId, MsgContent)
msg_ = Text
-> ByteString
-> CM ConnectViaContactResult
-> CM ConnectViaContactResult
forall a. Text -> ByteString -> CM a -> CM a
withInvitationLock Text
"connectViaContact" (ConnReqContact -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ConnReqContact
cReq) (CM ConnectViaContactResult -> CM ConnectViaContactResult)
-> CM ConnectViaContactResult -> CM ConnectViaContactResult
forall a b. (a -> b) -> a -> b
$ do
      let groupLinkId :: Maybe GroupLinkId
groupLinkId = Maybe Text
crClientData Maybe Text
-> (Text -> Maybe CReqClientData) -> Maybe CReqClientData
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe CReqClientData
forall a. FromJSON a => Text -> Maybe a
decodeJSON Maybe CReqClientData
-> (CReqClientData -> Maybe GroupLinkId) -> Maybe GroupLinkId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(CRDataGroup GroupLinkId
gli) -> GroupLinkId -> Maybe GroupLinkId
forall a. a -> Maybe a
Just GroupLinkId
gli
      -- groupLinkId is Nothing for business chats
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (SharedMsgId, MsgContent) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (SharedMsgId, MsgContent)
msg_ Bool -> Bool -> Bool
&& Maybe GroupLinkId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GroupLinkId
groupLinkId) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEConnReqMessageProhibited
      case Maybe PreparedChatEntity
preparedEntity_ of
        Just (PCEContact ct :: Contact
ct@Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn}) -> case Maybe Connection
activeConn of
          Maybe Connection
Nothing -> Maybe GroupLinkId -> Maybe XContactId -> CM ConnectViaContactResult
connect' Maybe GroupLinkId
forall a. Maybe a
Nothing Maybe XContactId
forall a. Maybe a
Nothing
          Just conn :: Connection
conn@Connection {ConnStatus
connStatus :: Connection -> ConnStatus
connStatus :: ConnStatus
connStatus, Maybe XContactId
xContactId :: Maybe XContactId
xContactId :: Connection -> Maybe XContactId
xContactId} -> case ConnStatus
connStatus of
            ConnStatus
ConnPrepared -> Maybe XContactId
-> Connection
-> Maybe (Maybe GroupInfo)
-> CM ConnectViaContactResult
joinPreparedConn' Maybe XContactId
xContactId Connection
conn Maybe (Maybe GroupInfo)
forall a. Maybe a
Nothing
            ConnStatus
_ -> ConnectViaContactResult -> CM ConnectViaContactResult
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectViaContactResult -> CM ConnectViaContactResult)
-> ConnectViaContactResult -> CM ConnectViaContactResult
forall a b. (a -> b) -> a -> b
$ Contact -> ConnectViaContactResult
CVRConnectedContact Contact
ct
        Just (PCEGroup GroupInfo
gInfo GroupMember {Maybe Connection
activeConn :: GroupMember -> Maybe Connection
activeConn :: Maybe Connection
activeConn}) -> case Maybe Connection
activeConn of
          Maybe Connection
Nothing -> Maybe GroupLinkId -> Maybe XContactId -> CM ConnectViaContactResult
connect' Maybe GroupLinkId
groupLinkId Maybe XContactId
forall a. Maybe a
Nothing
          Just conn :: Connection
conn@Connection {ConnStatus
connStatus :: Connection -> ConnStatus
connStatus :: ConnStatus
connStatus, Maybe XContactId
xContactId :: Connection -> Maybe XContactId
xContactId :: Maybe XContactId
xContactId} -> case ConnStatus
connStatus of
            ConnStatus
ConnPrepared -> Maybe XContactId
-> Connection
-> Maybe (Maybe GroupInfo)
-> CM ConnectViaContactResult
joinPreparedConn' Maybe XContactId
xContactId Connection
conn (Maybe (Maybe GroupInfo) -> CM ConnectViaContactResult)
-> Maybe (Maybe GroupInfo) -> CM ConnectViaContactResult
forall a b. (a -> b) -> a -> b
$ Maybe GroupInfo -> Maybe (Maybe GroupInfo)
forall a. a -> Maybe a
Just (GroupInfo -> Maybe GroupInfo
forall a. a -> Maybe a
Just GroupInfo
gInfo)
            ConnStatus
_ -> Maybe GroupLinkId -> Maybe XContactId -> CM ConnectViaContactResult
connect' Maybe GroupLinkId
groupLinkId Maybe XContactId
xContactId -- why not "already connected" for host member?
        Maybe PreparedChatEntity
Nothing ->
          (Connection -> IO (Either (Maybe Connection) Contact))
-> CM (Either (Maybe Connection) Contact)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> ConnReqUriHash
-> ConnReqUriHash
-> IO (Either (Maybe Connection) Contact)
getConnReqContactXContactId Connection
db VersionRangeChat
vr User
user ConnReqUriHash
cReqHash1 ConnReqUriHash
cReqHash2) CM (Either (Maybe Connection) Contact)
-> (Either (Maybe Connection) Contact
    -> CM ConnectViaContactResult)
-> CM ConnectViaContactResult
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right ct :: Contact
ct@Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} -> case Maybe GroupLinkId
groupLinkId of
              Maybe GroupLinkId
Nothing -> case Maybe Connection
activeConn of
                Just conn :: Connection
conn@Connection {connStatus :: Connection -> ConnStatus
connStatus = ConnStatus
ConnPrepared, Maybe XContactId
xContactId :: Connection -> Maybe XContactId
xContactId :: Maybe XContactId
xContactId} -> Maybe XContactId
-> Connection
-> Maybe (Maybe GroupInfo)
-> CM ConnectViaContactResult
joinPreparedConn' Maybe XContactId
xContactId Connection
conn Maybe (Maybe GroupInfo)
forall a. Maybe a
Nothing
                Maybe Connection
_ -> ConnectViaContactResult -> CM ConnectViaContactResult
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectViaContactResult -> CM ConnectViaContactResult)
-> ConnectViaContactResult -> CM ConnectViaContactResult
forall a b. (a -> b) -> a -> b
$ Contact -> ConnectViaContactResult
CVRConnectedContact Contact
ct
              Just GroupLinkId
gLinkId ->
                -- allow repeat contact request
                -- TODO [short links] is this branch needed? it probably remained from the time we created host contact
                Maybe GroupLinkId -> Maybe XContactId -> CM ConnectViaContactResult
connect' (GroupLinkId -> Maybe GroupLinkId
forall a. a -> Maybe a
Just GroupLinkId
gLinkId) Maybe XContactId
forall a. Maybe a
Nothing
            Left Maybe Connection
conn_ -> case Maybe Connection
conn_ of
              Just conn :: Connection
conn@Connection {connStatus :: Connection -> ConnStatus
connStatus = ConnStatus
ConnPrepared, Maybe XContactId
xContactId :: Connection -> Maybe XContactId
xContactId :: Maybe XContactId
xContactId} -> Maybe XContactId
-> Connection
-> Maybe (Maybe GroupInfo)
-> CM ConnectViaContactResult
joinPreparedConn' Maybe XContactId
xContactId Connection
conn (Maybe (Maybe GroupInfo) -> CM ConnectViaContactResult)
-> Maybe (Maybe GroupInfo) -> CM ConnectViaContactResult
forall a b. (a -> b) -> a -> b
$ Maybe GroupLinkId
groupLinkId Maybe GroupLinkId -> Maybe GroupInfo -> Maybe (Maybe GroupInfo)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe GroupInfo
forall a. Maybe a
Nothing
              -- TODO [short links] this is executed on repeat request after success
              -- it probably should send the second message without creating the second connection?
              Just Connection {Maybe XContactId
xContactId :: Connection -> Maybe XContactId
xContactId :: Maybe XContactId
xContactId} -> Maybe GroupLinkId -> Maybe XContactId -> CM ConnectViaContactResult
connect' Maybe GroupLinkId
groupLinkId Maybe XContactId
xContactId
              Maybe Connection
Nothing -> Maybe GroupLinkId -> Maybe XContactId -> CM ConnectViaContactResult
connect' Maybe GroupLinkId
groupLinkId Maybe XContactId
forall a. Maybe a
Nothing
      where
        cReqHash :: ConnReqContact -> ConnReqUriHash
cReqHash = ByteString -> ConnReqUriHash
ConnReqUriHash (ByteString -> ConnReqUriHash)
-> (ConnReqContact -> ByteString)
-> ConnReqContact
-> ConnReqUriHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
C.sha256Hash (ByteString -> ByteString)
-> (ConnReqContact -> ByteString) -> ConnReqContact -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnReqContact -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode
        cReqHash1 :: ConnReqUriHash
cReqHash1 = ConnReqContact -> ConnReqUriHash
cReqHash (ConnReqContact -> ConnReqUriHash)
-> ConnReqContact -> ConnReqUriHash
forall a b. (a -> b) -> a -> b
$ ConnReqUriData -> ConnReqContact
CRContactUri ConnReqUriData
crData {crScheme = SSSimplex}
        cReqHash2 :: ConnReqUriHash
cReqHash2 = ConnReqContact -> ConnReqUriHash
cReqHash (ConnReqContact -> ConnReqUriHash)
-> ConnReqContact -> ConnReqUriHash
forall a b. (a -> b) -> a -> b
$ ConnReqUriData -> ConnReqContact
CRContactUri ConnReqUriData
crData {crScheme = simplexChat}
        joinPreparedConn' :: Maybe XContactId
-> Connection
-> Maybe (Maybe GroupInfo)
-> CM ConnectViaContactResult
joinPreparedConn' Maybe XContactId
xContactId_ conn :: Connection
conn@Connection {Maybe Int64
customUserProfileId :: Connection -> Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId} Maybe (Maybe GroupInfo)
gInfo_ = do
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
incognito Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int64
customUserProfileId) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"incognito mode is different from prepared connection"
          XContactId
xContactId <- Maybe XContactId -> CM XContactId
mkXContactId Maybe XContactId
xContactId_
          Maybe LocalProfile
localIncognitoProfile <- Maybe Int64
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int64
customUserProfileId ((Int64
  -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe LocalProfile))
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall a b. (a -> b) -> a -> b
$ \Int64
pId -> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO LocalProfile)
 -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById Connection
db Int64
userId Int64
pId
          let incognitoProfile :: Maybe Profile
incognitoProfile = LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> Maybe LocalProfile -> Maybe Profile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalProfile
localIncognitoProfile
          Connection
conn' <- User
-> Connection
-> ConnReqContact
-> Maybe Profile
-> XContactId
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> Maybe (Maybe GroupInfo)
-> PQSupport
-> CM Connection
joinContact User
user Connection
conn ConnReqContact
cReq Maybe Profile
incognitoProfile XContactId
xContactId Maybe SharedMsgId
welcomeSharedMsgId Maybe (SharedMsgId, MsgContent)
msg_ Maybe (Maybe GroupInfo)
gInfo_ PQSupport
PQSupportOn
          ConnectViaContactResult -> CM ConnectViaContactResult
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectViaContactResult -> CM ConnectViaContactResult)
-> ConnectViaContactResult -> CM ConnectViaContactResult
forall a b. (a -> b) -> a -> b
$ Connection -> Maybe Profile -> ConnectViaContactResult
CVRSentInvitation Connection
conn' Maybe Profile
incognitoProfile
        connect' :: Maybe GroupLinkId -> Maybe XContactId -> CM ConnectViaContactResult
connect' Maybe GroupLinkId
groupLinkId Maybe XContactId
xContactId_ = do
          let inGroup :: Bool
inGroup = Maybe GroupLinkId -> Bool
forall a. Maybe a -> Bool
isJust Maybe GroupLinkId
groupLinkId
              pqSup :: PQSupport
pqSup = if Bool
inGroup then PQSupport
PQSupportOff else PQSupport
PQSupportOn
          (ByteString
connId, Version ChatVersion
chatV) <- User
-> ConnReqContact
-> PQSupport
-> CM (ByteString, Version ChatVersion)
prepareContact User
user ConnReqContact
cReq PQSupport
pqSup
          XContactId
xContactId <- Maybe XContactId -> CM XContactId
mkXContactId Maybe XContactId
xContactId_
          -- [incognito] generate profile to send
          Maybe Profile
incognitoProfile <- if Bool
incognito then Profile -> Maybe Profile
forall a. a -> Maybe a
Just (Profile -> Maybe Profile)
-> ExceptT ChatError (ReaderT ChatController IO) Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Profile -> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Profile
generateRandomProfile else Maybe Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Profile
forall a. Maybe a
Nothing
          SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
          let sLnk' :: Maybe (ConnShortLink 'CMContact)
sLnk' = ConnShortLink 'CMContact -> ConnShortLink 'CMContact
forall (m :: ConnectionMode). ConnShortLink m -> ConnShortLink m
serverShortLink (ConnShortLink 'CMContact -> ConnShortLink 'CMContact)
-> Maybe (ConnShortLink 'CMContact)
-> Maybe (ConnShortLink 'CMContact)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ConnShortLink 'CMContact)
sLnk
          Connection
conn <- (Connection -> IO Connection) -> CM Connection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Connection) -> CM Connection)
-> (Connection -> IO Connection) -> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64
-> ByteString
-> Maybe PreparedChatEntity
-> ConnReqContact
-> ConnReqUriHash
-> Maybe (ConnShortLink 'CMContact)
-> XContactId
-> Maybe Profile
-> Maybe GroupLinkId
-> SubscriptionMode
-> Version ChatVersion
-> PQSupport
-> IO Connection
createConnReqConnection Connection
db Int64
userId ByteString
connId Maybe PreparedChatEntity
preparedEntity_ ConnReqContact
cReq ConnReqUriHash
cReqHash1 Maybe (ConnShortLink 'CMContact)
sLnk' XContactId
xContactId Maybe Profile
incognitoProfile Maybe GroupLinkId
groupLinkId SubscriptionMode
subMode Version ChatVersion
chatV PQSupport
pqSup
          Connection
conn' <- User
-> Connection
-> ConnReqContact
-> Maybe Profile
-> XContactId
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> Maybe (Maybe GroupInfo)
-> PQSupport
-> CM Connection
joinContact User
user Connection
conn ConnReqContact
cReq Maybe Profile
incognitoProfile XContactId
xContactId Maybe SharedMsgId
welcomeSharedMsgId Maybe (SharedMsgId, MsgContent)
msg_ (Maybe GroupLinkId
groupLinkId Maybe GroupLinkId -> Maybe GroupInfo -> Maybe (Maybe GroupInfo)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe GroupInfo
forall a. Maybe a
Nothing) PQSupport
pqSup
          ConnectViaContactResult -> CM ConnectViaContactResult
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectViaContactResult -> CM ConnectViaContactResult)
-> ConnectViaContactResult -> CM ConnectViaContactResult
forall a b. (a -> b) -> a -> b
$ Connection -> Maybe Profile -> ConnectViaContactResult
CVRSentInvitation Connection
conn' Maybe Profile
incognitoProfile
    connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse
    connectContactViaAddress :: User -> Bool -> Contact -> CreatedLinkContact -> CM ChatResponse
connectContactViaAddress user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Bool
incognito ct :: Contact
ct@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId, Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} (CCLink ConnReqContact
cReq Maybe (ConnShortLink 'CMContact)
shortLink) =
      Text -> ByteString -> CM ChatResponse -> CM ChatResponse
forall a. Text -> ByteString -> CM a -> CM a
withInvitationLock Text
"connectContactViaAddress" (ConnReqContact -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ConnReqContact
cReq) (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
        case Maybe Connection
activeConn of
          Maybe Connection
Nothing -> do
            let pqSup :: PQSupport
pqSup = PQSupport
PQSupportOn
            (ByteString
connId, Version ChatVersion
chatV) <- User
-> ConnReqContact
-> PQSupport
-> CM (ByteString, Version ChatVersion)
prepareContact User
user ConnReqContact
cReq PQSupport
pqSup
            XContactId
newXContactId <- ByteString -> XContactId
XContactId (ByteString -> XContactId) -> CM ByteString -> CM XContactId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> CM ByteString
drgRandomBytes Int
16
            -- [incognito] generate profile to send
            Maybe Profile
incognitoProfile <- if Bool
incognito then Profile -> Maybe Profile
forall a. a -> Maybe a
Just (Profile -> Maybe Profile)
-> ExceptT ChatError (ReaderT ChatController IO) Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Profile -> ExceptT ChatError (ReaderT ChatController IO) Profile
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Profile
generateRandomProfile else Maybe Profile
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Profile)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Profile
forall a. Maybe a
Nothing
            SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
            let cReqHash :: ConnReqUriHash
cReqHash = ByteString -> ConnReqUriHash
ConnReqUriHash (ByteString -> ConnReqUriHash)
-> (ByteString -> ByteString) -> ByteString -> ConnReqUriHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
C.sha256Hash (ByteString -> ConnReqUriHash) -> ByteString -> ConnReqUriHash
forall a b. (a -> b) -> a -> b
$ ConnReqContact -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode ConnReqContact
cReq
            Connection
conn <- (Connection -> IO Connection) -> CM Connection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Connection) -> CM Connection)
-> (Connection -> IO Connection) -> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Int64
-> ByteString
-> Maybe PreparedChatEntity
-> ConnReqContact
-> ConnReqUriHash
-> Maybe (ConnShortLink 'CMContact)
-> XContactId
-> Maybe Profile
-> Maybe GroupLinkId
-> SubscriptionMode
-> Version ChatVersion
-> PQSupport
-> IO Connection
createConnReqConnection Connection
db Int64
userId ByteString
connId (PreparedChatEntity -> Maybe PreparedChatEntity
forall a. a -> Maybe a
Just (PreparedChatEntity -> Maybe PreparedChatEntity)
-> PreparedChatEntity -> Maybe PreparedChatEntity
forall a b. (a -> b) -> a -> b
$ Contact -> PreparedChatEntity
PCEContact Contact
ct) ConnReqContact
cReq ConnReqUriHash
cReqHash Maybe (ConnShortLink 'CMContact)
shortLink XContactId
newXContactId Maybe Profile
incognitoProfile Maybe GroupLinkId
forall a. Maybe a
Nothing SubscriptionMode
subMode Version ChatVersion
chatV PQSupport
pqSup
            CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM Connection
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> Connection
-> ConnReqContact
-> Maybe Profile
-> XContactId
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> Maybe (Maybe GroupInfo)
-> PQSupport
-> CM Connection
joinContact User
user Connection
conn ConnReqContact
cReq Maybe Profile
incognitoProfile XContactId
newXContactId Maybe SharedMsgId
forall a. Maybe a
Nothing Maybe (SharedMsgId, MsgContent)
forall a. Maybe a
Nothing Maybe (Maybe GroupInfo)
forall a. Maybe a
Nothing PQSupport
pqSup
            Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Maybe Profile -> ChatResponse
CRSentInvitationToContact User
user Contact
ct' Maybe Profile
incognitoProfile
          Just conn :: Connection
conn@Connection {ConnStatus
connStatus :: Connection -> ConnStatus
connStatus :: ConnStatus
connStatus, xContactId :: Connection -> Maybe XContactId
xContactId = Maybe XContactId
xContactId_, Maybe Int64
customUserProfileId :: Connection -> Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId} -> case ConnStatus
connStatus of
            ConnStatus
ConnPrepared -> do
              Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
incognito Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int64
customUserProfileId) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"incognito mode is different from prepared connection"
              XContactId
xContactId <- Maybe XContactId -> CM XContactId
mkXContactId Maybe XContactId
xContactId_
              Maybe LocalProfile
localIncognitoProfile <- Maybe Int64
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int64
customUserProfileId ((Int64
  -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe LocalProfile))
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall a b. (a -> b) -> a -> b
$ \Int64
pId -> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO LocalProfile)
 -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById Connection
db Int64
userId Int64
pId
              let incognitoProfile :: Maybe Profile
incognitoProfile = LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> Maybe LocalProfile -> Maybe Profile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalProfile
localIncognitoProfile
              CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM Connection
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> Connection
-> ConnReqContact
-> Maybe Profile
-> XContactId
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> Maybe (Maybe GroupInfo)
-> PQSupport
-> CM Connection
joinContact User
user Connection
conn ConnReqContact
cReq Maybe Profile
incognitoProfile XContactId
xContactId Maybe SharedMsgId
forall a. Maybe a
Nothing Maybe (SharedMsgId, MsgContent)
forall a. Maybe a
Nothing Maybe (Maybe GroupInfo)
forall a. Maybe a
Nothing PQSupport
PQSupportOn
              Contact
ct' <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
              ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Maybe Profile -> ChatResponse
CRSentInvitationToContact User
user Contact
ct' Maybe Profile
incognitoProfile
            ConnStatus
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"contact already has connection"
    prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat)
    prepareContact :: User
-> ConnReqContact
-> PQSupport
-> CM (ByteString, Version ChatVersion)
prepareContact User
user ConnReqContact
cReq PQSupport
pqSup = do
      -- 0) toggle disabled - PQSupportOff
      -- 1) toggle enabled, address supports PQ (connRequestPQSupport returns Just True) - PQSupportOn, enable support with compression
      -- 2) toggle enabled, address doesn't support PQ - PQSupportOn but without compression, with version range indicating support
      ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe (VersionSMPA, PQSupport))
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((AgentClient -> IO (Maybe (VersionSMPA, PQSupport)))
-> ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport))
forall a. (AgentClient -> IO a) -> CM' a
withAgent' ((AgentClient -> IO (Maybe (VersionSMPA, PQSupport)))
 -> ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport)))
-> (AgentClient -> IO (Maybe (VersionSMPA, PQSupport)))
-> ReaderT ChatController IO (Maybe (VersionSMPA, PQSupport))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> PQSupport
-> ConnReqContact
-> IO (Maybe (VersionSMPA, PQSupport))
forall (c :: ConnectionMode).
AgentClient
-> PQSupport
-> ConnectionRequestUri c
-> IO (Maybe (VersionSMPA, PQSupport))
connRequestPQSupport AgentClient
a PQSupport
pqSup ConnReqContact
cReq) ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Maybe (VersionSMPA, PQSupport))
-> (Maybe (VersionSMPA, PQSupport)
    -> CM (ByteString, Version ChatVersion))
-> CM (ByteString, Version ChatVersion)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (VersionSMPA, PQSupport)
Nothing -> ChatErrorType -> CM (ByteString, Version ChatVersion)
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidConnReq
        Just (VersionSMPA
agentV, PQSupport
_) -> do
          let chatV :: Version ChatVersion
chatV = VersionSMPA -> Version ChatVersion
agentToChatVersion VersionSMPA
agentV
          ByteString
connId <- (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient -> ExceptT AgentErrorType IO ByteString)
 -> CM ByteString)
-> (AgentClient -> ExceptT AgentErrorType IO ByteString)
-> CM ByteString
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> Int64
-> Bool
-> ConnReqContact
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
forall (c :: ConnectionMode).
AgentClient
-> Int64
-> Bool
-> ConnectionRequestUri c
-> PQSupport
-> ExceptT AgentErrorType IO ByteString
prepareConnectionToJoin AgentClient
a (User -> Int64
aUserId User
user) Bool
True ConnReqContact
cReq PQSupport
pqSup
          (ByteString, Version ChatVersion)
-> CM (ByteString, Version ChatVersion)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString
connId, Version ChatVersion
chatV)
    mkXContactId :: Maybe XContactId -> CM XContactId
    mkXContactId :: Maybe XContactId -> CM XContactId
mkXContactId = CM XContactId
-> (XContactId -> CM XContactId)
-> Maybe XContactId
-> CM XContactId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> XContactId
XContactId (ByteString -> XContactId) -> CM ByteString -> CM XContactId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> CM ByteString
drgRandomBytes Int
16) XContactId -> CM XContactId
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfo) -> PQSupport -> CM Connection
    joinContact :: User
-> Connection
-> ConnReqContact
-> Maybe Profile
-> XContactId
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> Maybe (Maybe GroupInfo)
-> PQSupport
-> CM Connection
joinContact User
user conn :: Connection
conn@Connection {connChatVersion :: Connection -> Version ChatVersion
connChatVersion = Version ChatVersion
chatV} ConnReqContact
cReq Maybe Profile
incognitoProfile XContactId
xContactId Maybe SharedMsgId
welcomeSharedMsgId Maybe (SharedMsgId, MsgContent)
msg_ Maybe (Maybe GroupInfo)
gInfo_ PQSupport
pqSup = do
      -- gInfo_ is Maybe (Maybe GroupInfo), where Just Nothing means "some unknown group", e.g. when joining via link without profile
      let profileToSend :: Profile
profileToSend = case Maybe (Maybe GroupInfo)
gInfo_ of
            Just Maybe GroupInfo
gInfo_' ->
              let allowSimplexLinks :: Bool
allowSimplexLinks = Bool -> (GroupInfo -> Bool) -> Maybe GroupInfo -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (SGroupFeature 'GFSimplexLinks -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureUserAllowed SGroupFeature 'GFSimplexLinks
SGFSimplexLinks) Maybe GroupInfo
gInfo_'
               in User -> Bool -> Maybe Profile -> Profile
userProfileInGroup' User
user Bool
allowSimplexLinks Maybe Profile
incognitoProfile
            Maybe (Maybe GroupInfo)
Nothing -> User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user Maybe Profile
incognitoProfile Maybe Contact
forall a. Maybe a
Nothing Bool
True
      ByteString
dm <- PQSupport
-> Version ChatVersion -> ChatMsgEvent 'Json -> CM ByteString
forall (e :: MsgEncoding).
MsgEncodingI e =>
PQSupport -> Version ChatVersion -> ChatMsgEvent e -> CM ByteString
encodeConnInfoPQ PQSupport
pqSup Version ChatVersion
chatV (Profile
-> Maybe XContactId
-> Maybe SharedMsgId
-> Maybe (SharedMsgId, MsgContent)
-> ChatMsgEvent 'Json
XContact Profile
profileToSend (XContactId -> Maybe XContactId
forall a. a -> Maybe a
Just XContactId
xContactId) Maybe SharedMsgId
welcomeSharedMsgId Maybe (SharedMsgId, MsgContent)
msg_)
      SubscriptionMode
subMode <- (ChatController -> TVar SubscriptionMode) -> CM SubscriptionMode
forall a. (ChatController -> TVar a) -> CM a
chatReadVar ChatController -> TVar SubscriptionMode
subscriptionMode
      ExceptT
  ChatError
  (ReaderT ChatController IO)
  (Bool, Maybe (DBEntityId' 'DBStored))
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   ChatError
   (ReaderT ChatController IO)
   (Bool, Maybe (DBEntityId' 'DBStored))
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (AgentClient
 -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (Bool, Maybe (DBEntityId' 'DBStored)))
-> (AgentClient
    -> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Bool, Maybe (DBEntityId' 'DBStored))
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnReqContact
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
forall (c :: ConnectionMode).
AgentClient
-> NetworkRequestMode
-> Int64
-> ByteString
-> Bool
-> ConnectionRequestUri c
-> ByteString
-> PQSupport
-> SubscriptionMode
-> ExceptT AgentErrorType IO (Bool, Maybe (DBEntityId' 'DBStored))
joinConnection AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) (Connection -> ByteString
aConnId Connection
conn) Bool
True ConnReqContact
cReq ByteString
dm PQSupport
pqSup SubscriptionMode
subMode
      (Connection -> IO Connection) -> CM Connection
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO Connection) -> CM Connection)
-> (Connection -> IO Connection) -> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> Connection -> ConnStatus -> ConnStatus -> IO Connection
updateConnectionStatusFromTo Connection
db Connection
conn ConnStatus
ConnPrepared ConnStatus
ConnJoined
    contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
    contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
contactMember Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId} =
      (GroupMember -> Bool) -> [GroupMember] -> Maybe GroupMember
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((GroupMember -> Bool) -> [GroupMember] -> Maybe GroupMember)
-> (GroupMember -> Bool) -> [GroupMember] -> Maybe GroupMember
forall a b. (a -> b) -> a -> b
$ \GroupMember {memberContactId :: GroupMember -> Maybe Int64
memberContactId = Maybe Int64
cId, memberStatus :: GroupMember -> GroupMemberStatus
memberStatus = GroupMemberStatus
s} ->
        Maybe Int64
cId Maybe Int64 -> Maybe Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
contactId Bool -> Bool -> Bool
&& GroupMemberStatus
s GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupMemberStatus
GSMemRejected Bool -> Bool -> Bool
&& GroupMemberStatus
s GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupMemberStatus
GSMemRemoved Bool -> Bool -> Bool
&& GroupMemberStatus
s GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupMemberStatus
GSMemLeft
    checkSndFile :: CryptoFile -> CM Integer
    checkSndFile :: CryptoFile -> ExceptT ChatError (ReaderT ChatController IO) Integer
checkSndFile (CryptoFile String
f Maybe CryptoFileArgs
cfArgs) = do
      String
fsFilePath <- ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO String
 -> ExceptT ChatError (ReaderT ChatController IO) String)
-> ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall a b. (a -> b) -> a -> b
$ String -> ReaderT ChatController IO String
toFSFilePath String
f
      ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (m :: * -> *). MonadIO m => String -> m Bool
doesFileExist String
fsFilePath) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatErrorType
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ChatErrorType
CEFileNotFound String
f
      Integer
fileSize <- IO Integer -> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer
 -> ExceptT ChatError (ReaderT ChatController IO) Integer)
-> IO Integer
-> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a b. (a -> b) -> a -> b
$ CryptoFile -> IO Integer
CF.getFileContentsSize (CryptoFile -> IO Integer) -> CryptoFile -> IO Integer
forall a b. (a -> b) -> a -> b
$ String -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile String
fsFilePath Maybe CryptoFileArgs
cfArgs
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
fileSize Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
maxFileSize) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ChatErrorType
CEFileSize String
f
      Integer -> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
fileSize
    updateProfile :: User -> Profile -> CM ChatResponse
    updateProfile :: User -> Profile -> CM ChatResponse
updateProfile User
user Profile
p' = User -> Profile -> Bool -> CM User -> CM ChatResponse
updateProfile_ User
user Profile
p' Bool
True (CM User -> CM ChatResponse) -> CM User -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ (Connection -> ExceptT StoreError IO User) -> CM User
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO User) -> CM User)
-> (Connection -> ExceptT StoreError IO User) -> CM User
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Profile -> ExceptT StoreError IO User
updateUserProfile Connection
db User
user Profile
p'
    updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse
    updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse
updateProfile_ user :: User
user@User {profile :: User -> LocalProfile
profile = p :: LocalProfile
p@LocalProfile {displayName :: LocalProfile -> Text
displayName = Text
n}} p' :: Profile
p'@Profile {displayName :: Profile -> Text
displayName = Text
n'} Bool
shouldUpdateAddressData CM User
updateUser
      | Profile
p' Profile -> Profile -> Bool
forall a. Eq a => a -> a -> Bool
== LocalProfile -> Profile
fromLocalProfile LocalProfile
p = ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> ChatResponse
CRUserProfileNoChange User
user
      | Bool
otherwise = do
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
n') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT ChatError (ReaderT ChatController IO) ()
checkValidName Text
n'
          -- read contacts before user update to correctly merge preferences
          [Contact]
contacts <- (Connection -> IO [Contact])
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [Contact])
 -> ExceptT ChatError (ReaderT ChatController IO) [Contact])
-> (Connection -> IO [Contact])
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> VersionRangeChat -> User -> IO [Contact]
getUserContacts Connection
db VersionRangeChat
vr User
user
          User
user' <- CM User
updateUser
          (ChatController -> TVar (Maybe User))
-> ExceptT
     ChatError (ReaderT ChatController IO) (TVar (Maybe User))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe User)
currentUser ExceptT ChatError (ReaderT ChatController IO) (TVar (Maybe User))
-> (TVar (Maybe User)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (TVar (Maybe User) -> STM ())
-> TVar (Maybe User)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar (Maybe User) -> Maybe User -> STM ()
forall a. TVar a -> a -> STM ()
`writeTVar` User -> Maybe User
forall a. a -> Maybe a
Just User
user')
          Text -> CM ChatResponse -> CM ChatResponse
forall a. Text -> CM a -> CM a
withChatLock Text
"updateProfile" (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ do
            Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdateAddressData (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> ExceptT ChatError (ReaderT ChatController IO) ()
setMyAddressData' User
user'
            UserProfileUpdateSummary
summary <- User -> [Contact] -> CM UserProfileUpdateSummary
sendUpdateToContacts User
user' [Contact]
contacts
            ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User
-> Profile -> Profile -> UserProfileUpdateSummary -> ChatResponse
CRUserProfileUpdated User
user' (LocalProfile -> Profile
fromLocalProfile LocalProfile
p) Profile
p' UserProfileUpdateSummary
summary
      where
        setMyAddressData' :: User -> CM ()
        setMyAddressData' :: User -> ExceptT ChatError (ReaderT ChatController IO) ()
setMyAddressData' User
user' =
          (Connection -> IO (Either StoreError UserContactLink))
-> CM (Either StoreError UserContactLink)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> ExceptT StoreError IO UserContactLink
-> IO (Either StoreError UserContactLink)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT StoreError IO UserContactLink
 -> IO (Either StoreError UserContactLink))
-> ExceptT StoreError IO UserContactLink
-> IO (Either StoreError UserContactLink)
forall a b. (a -> b) -> a -> b
$ Connection -> User -> ExceptT StoreError IO UserContactLink
getUserAddress Connection
db User
user) CM (Either StoreError UserContactLink)
-> (Either StoreError UserContactLink
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right ucl :: UserContactLink
ucl@UserContactLink {Bool
shortLinkDataSet :: UserContactLink -> Bool
shortLinkDataSet :: Bool
shortLinkDataSet}
              | Bool
shortLinkDataSet -> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ChatError (ReaderT ChatController IO) UserContactLink
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
setMyAddressData User
user' UserContactLink
ucl
            Either StoreError UserContactLink
_ -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        sendUpdateToContacts :: User -> [Contact] -> CM UserProfileUpdateSummary
        sendUpdateToContacts :: User -> [Contact] -> CM UserProfileUpdateSummary
sendUpdateToContacts User
user' [Contact]
contacts = do
          let changedCts_ :: Maybe (NonEmpty ChangedProfileContact)
changedCts_ = [ChangedProfileContact] -> Maybe (NonEmpty ChangedProfileContact)
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([ChangedProfileContact] -> Maybe (NonEmpty ChangedProfileContact))
-> [ChangedProfileContact]
-> Maybe (NonEmpty ChangedProfileContact)
forall a b. (a -> b) -> a -> b
$ (Contact -> [ChangedProfileContact] -> [ChangedProfileContact])
-> [ChangedProfileContact] -> [Contact] -> [ChangedProfileContact]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Contact -> [ChangedProfileContact] -> [ChangedProfileContact]
addChangedProfileContact [] [Contact]
contacts
          case Maybe (NonEmpty ChangedProfileContact)
changedCts_ of
            Maybe (NonEmpty ChangedProfileContact)
Nothing -> UserProfileUpdateSummary -> CM UserProfileUpdateSummary
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserProfileUpdateSummary -> CM UserProfileUpdateSummary)
-> UserProfileUpdateSummary -> CM UserProfileUpdateSummary
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Contact] -> UserProfileUpdateSummary
UserProfileUpdateSummary Int
0 Int
0 []
            Just NonEmpty ChangedProfileContact
changedCts -> do
              let idsEvts :: NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
idsEvts = (ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json))
-> NonEmpty ChangedProfileContact
-> NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json)
ctSndEvent NonEmpty ChangedProfileContact
changedCts
              NonEmpty (Either ChatError ChatMsgReq)
msgReqs_ <- ReaderT ChatController IO (NonEmpty (Either ChatError ChatMsgReq))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError ChatMsgReq))
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO (NonEmpty (Either ChatError ChatMsgReq))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (Either ChatError ChatMsgReq)))
-> ReaderT
     ChatController IO (NonEmpty (Either ChatError ChatMsgReq))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError ChatMsgReq))
forall a b. (a -> b) -> a -> b
$ (ChangedProfileContact
 -> Either ChatError SndMessage -> Either ChatError ChatMsgReq)
-> NonEmpty ChangedProfileContact
-> NonEmpty (Either ChatError SndMessage)
-> NonEmpty (Either ChatError ChatMsgReq)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
L.zipWith ChangedProfileContact
-> Either ChatError SndMessage -> Either ChatError ChatMsgReq
ctMsgReq NonEmpty ChangedProfileContact
changedCts (NonEmpty (Either ChatError SndMessage)
 -> NonEmpty (Either ChatError ChatMsgReq))
-> ReaderT
     ChatController IO (NonEmpty (Either ChatError SndMessage))
-> ReaderT
     ChatController IO (NonEmpty (Either ChatError ChatMsgReq))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
-> ReaderT
     ChatController IO (NonEmpty (Either ChatError SndMessage))
forall (e :: MsgEncoding) (t :: * -> *).
(MsgEncodingI e, Traversable t) =>
t (ConnOrGroupId, ChatMsgEvent e)
-> CM' (t (Either ChatError SndMessage))
createSndMessages NonEmpty (ConnOrGroupId, ChatMsgEvent 'Json)
idsEvts
              ([ChatError]
errs, [ChangedProfileContact]
cts) <- [Either ChatError ChangedProfileContact]
-> ([ChatError], [ChangedProfileContact])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError ChangedProfileContact]
 -> ([ChatError], [ChangedProfileContact]))
-> (NonEmpty (Either ChatError ([Int64], PQEncryption))
    -> [Either ChatError ChangedProfileContact])
-> NonEmpty (Either ChatError ([Int64], PQEncryption))
-> ([ChatError], [ChangedProfileContact])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Either ChatError ChangedProfileContact)
-> [Either ChatError ChangedProfileContact]
forall a. NonEmpty a -> [a]
L.toList (NonEmpty (Either ChatError ChangedProfileContact)
 -> [Either ChatError ChangedProfileContact])
-> (NonEmpty (Either ChatError ([Int64], PQEncryption))
    -> NonEmpty (Either ChatError ChangedProfileContact))
-> NonEmpty (Either ChatError ([Int64], PQEncryption))
-> [Either ChatError ChangedProfileContact]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChangedProfileContact
 -> Either ChatError ([Int64], PQEncryption)
 -> Either ChatError ChangedProfileContact)
-> NonEmpty ChangedProfileContact
-> NonEmpty (Either ChatError ([Int64], PQEncryption))
-> NonEmpty (Either ChatError ChangedProfileContact)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
L.zipWith ((([Int64], PQEncryption) -> ChangedProfileContact)
-> Either ChatError ([Int64], PQEncryption)
-> Either ChatError ChangedProfileContact
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((([Int64], PQEncryption) -> ChangedProfileContact)
 -> Either ChatError ([Int64], PQEncryption)
 -> Either ChatError ChangedProfileContact)
-> (ChangedProfileContact
    -> ([Int64], PQEncryption) -> ChangedProfileContact)
-> ChangedProfileContact
-> Either ChatError ([Int64], PQEncryption)
-> Either ChatError ChangedProfileContact
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangedProfileContact
-> ([Int64], PQEncryption) -> ChangedProfileContact
forall a b. a -> b -> a
const) NonEmpty ChangedProfileContact
changedCts (NonEmpty (Either ChatError ([Int64], PQEncryption))
 -> ([ChatError], [ChangedProfileContact]))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError ([Int64], PQEncryption)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [ChangedProfileContact])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Either ChatError ChatMsgReq)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError ([Int64], PQEncryption)))
deliverMessagesB NonEmpty (Either ChatError ChatMsgReq)
msgReqs_
              Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
              let changedCts' :: [ChangedProfileContact]
changedCts' = (ChangedProfileContact -> Bool)
-> [ChangedProfileContact] -> [ChangedProfileContact]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ChangedProfileContact {Contact
ct :: Contact
ct :: ChangedProfileContact -> Contact
ct, Contact
ct' :: Contact
ct' :: ChangedProfileContact -> Contact
ct'} -> Contact -> Bool
directOrUsed Contact
ct' Bool -> Bool -> Bool
&& Contact -> ContactUserPreferences
mergedPreferences Contact
ct' ContactUserPreferences -> ContactUserPreferences -> Bool
forall a. Eq a => a -> a -> Bool
/= Contact -> ContactUserPreferences
mergedPreferences Contact
ct) [ChangedProfileContact]
cts
              ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [ChangedProfileContact] -> ReaderT ChatController IO ()
createContactsSndFeatureItems User
user' [ChangedProfileContact]
changedCts'
              UserProfileUpdateSummary -> CM UserProfileUpdateSummary
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                UserProfileUpdateSummary
                  { updateSuccesses :: Int
updateSuccesses = [ChangedProfileContact] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChangedProfileContact]
cts,
                    updateFailures :: Int
updateFailures = [ChatError] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChatError]
errs,
                    changedContacts :: [Contact]
changedContacts = (ChangedProfileContact -> Contact)
-> [ChangedProfileContact] -> [Contact]
forall a b. (a -> b) -> [a] -> [b]
map (\ChangedProfileContact {Contact
ct' :: ChangedProfileContact -> Contact
ct' :: Contact
ct'} -> Contact
ct') [ChangedProfileContact]
changedCts'
                  }
          where
            -- [incognito] filter out contacts with whom user has incognito connections
            addChangedProfileContact :: Contact -> [ChangedProfileContact] -> [ChangedProfileContact]
            addChangedProfileContact :: Contact -> [ChangedProfileContact] -> [ChangedProfileContact]
addChangedProfileContact Contact
ct [ChangedProfileContact]
changedCts = case Contact -> Either ChatError Connection
contactSendConn_ Contact
ct' of
              Right Connection
conn
                | Bool -> Bool
not (Connection -> Bool
connIncognito Connection
conn) Bool -> Bool -> Bool
&& Profile
mergedProfile' Profile -> Profile -> Bool
forall a. Eq a => a -> a -> Bool
/= Profile
mergedProfile ->
                    Contact
-> Contact -> Profile -> Connection -> ChangedProfileContact
ChangedProfileContact Contact
ct Contact
ct' Profile
mergedProfile' Connection
conn ChangedProfileContact
-> [ChangedProfileContact] -> [ChangedProfileContact]
forall a. a -> [a] -> [a]
: [ChangedProfileContact]
changedCts
              Either ChatError Connection
_ -> [ChangedProfileContact]
changedCts
              where
                mergedProfile :: Profile
mergedProfile = User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user Maybe Profile
forall a. Maybe a
Nothing (Contact -> Maybe Contact
forall a. a -> Maybe a
Just Contact
ct) Bool
False
                ct' :: Contact
ct' = User -> Contact -> Contact
updateMergedPreferences User
user' Contact
ct
                mergedProfile' :: Profile
mergedProfile' = User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user' Maybe Profile
forall a. Maybe a
Nothing (Contact -> Maybe Contact
forall a. a -> Maybe a
Just Contact
ct') Bool
False
            ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json)
            ctSndEvent :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json)
ctSndEvent ChangedProfileContact {Profile
mergedProfile' :: Profile
mergedProfile' :: ChangedProfileContact -> Profile
mergedProfile', conn :: ChangedProfileContact -> Connection
conn = Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId}} = (Int64 -> ConnOrGroupId
ConnectionId Int64
connId, Profile -> ChatMsgEvent 'Json
XInfo Profile
mergedProfile')
            ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq
            ctMsgReq :: ChangedProfileContact
-> Either ChatError SndMessage -> Either ChatError ChatMsgReq
ctMsgReq ChangedProfileContact {Connection
conn :: ChangedProfileContact -> Connection
conn :: Connection
conn} =
              (SndMessage -> ChatMsgReq)
-> Either ChatError SndMessage -> Either ChatError ChatMsgReq
forall a b. (a -> b) -> Either ChatError a -> Either ChatError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SndMessage -> ChatMsgReq)
 -> Either ChatError SndMessage -> Either ChatError ChatMsgReq)
-> (SndMessage -> ChatMsgReq)
-> Either ChatError SndMessage
-> Either ChatError ChatMsgReq
forall a b. (a -> b) -> a -> b
$ \SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId, ByteString
msgBody :: SndMessage -> ByteString
msgBody :: ByteString
msgBody} ->
                (Connection
conn, MsgFlags {notification :: Bool
notification = CMEventTag 'Json -> Bool
forall (e :: MsgEncoding). CMEventTag e -> Bool
hasNotification CMEventTag 'Json
XInfo_}, (ByteString -> ValueOrRef ByteString
forall a. a -> ValueOrRef a
vrValue ByteString
msgBody, [Int64
Item [Int64]
msgId]))
    setMyAddressData :: User -> UserContactLink -> CM UserContactLink
    setMyAddressData :: User
-> UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
setMyAddressData User
user ucl :: UserContactLink
ucl@UserContactLink {Int64
userContactLinkId :: UserContactLink -> Int64
userContactLinkId :: Int64
userContactLinkId, connLinkContact :: UserContactLink -> CreatedLinkContact
connLinkContact = CCLink ConnReqContact
connFullLink Maybe (ConnShortLink 'CMContact)
_sLnk_, AddressSettings
addressSettings :: UserContactLink -> AddressSettings
addressSettings :: AddressSettings
addressSettings} = do
      Connection
conn <- (Connection -> ExceptT StoreError IO Connection) -> CM Connection
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Connection) -> CM Connection)
-> (Connection -> ExceptT StoreError IO Connection)
-> CM Connection
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> ExceptT StoreError IO Connection
getUserAddressConnection Connection
db VersionRangeChat
vr User
user
      let shortLinkProfile :: Profile
shortLinkProfile = User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user Maybe Profile
forall a. Maybe a
Nothing Maybe Contact
forall a. Maybe a
Nothing Bool
True
          -- TODO [short links] do not save address to server if data did not change, spinners, error handling
          userData :: UserLinkData
userData = Profile -> Maybe AddressSettings -> UserLinkData
contactShortLinkData Profile
shortLinkProfile (Maybe AddressSettings -> UserLinkData)
-> Maybe AddressSettings -> UserLinkData
forall a b. (a -> b) -> a -> b
$ AddressSettings -> Maybe AddressSettings
forall a. a -> Maybe a
Just AddressSettings
addressSettings
          userLinkData :: UserConnLinkData 'CMContact
userLinkData = UserContactData -> UserConnLinkData 'CMContact
UserContactLinkData UserContactData {direct :: Bool
direct = Bool
True, owners :: [OwnerAuth]
owners = [], relays :: [ConnShortLink 'CMContact]
relays = [], UserLinkData
userData :: UserLinkData
userData :: UserLinkData
userData}
      ConnShortLink 'CMContact
sLnk <- ConnShortLink 'CMContact -> CM (ConnShortLink 'CMContact)
forall (m :: ConnectionMode).
ConnShortLink m -> CM (ConnShortLink m)
shortenShortLink' (ConnShortLink 'CMContact -> CM (ConnShortLink 'CMContact))
-> CM (ConnShortLink 'CMContact) -> CM (ConnShortLink 'CMContact)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (AgentClient
 -> ExceptT AgentErrorType IO (ConnShortLink 'CMContact))
-> CM (ConnShortLink 'CMContact)
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> NetworkRequestMode
-> ByteString
-> SConnectionMode 'CMContact
-> UserConnLinkData 'CMContact
-> Maybe Text
-> ExceptT AgentErrorType IO (ConnShortLink 'CMContact)
forall (c :: ConnectionMode).
AgentClient
-> NetworkRequestMode
-> ByteString
-> SConnectionMode c
-> UserConnLinkData c
-> Maybe Text
-> AE (ConnShortLink c)
setConnShortLink AgentClient
a NetworkRequestMode
nm (Connection -> ByteString
aConnId Connection
conn) SConnectionMode 'CMContact
SCMContact UserConnLinkData 'CMContact
userLinkData Maybe Text
forall a. Maybe a
Nothing)
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> ConnShortLink 'CMContact -> IO ()
setUserContactLinkShortLink Connection
db Int64
userContactLinkId ConnShortLink 'CMContact
sLnk
      let autoAccept' :: Maybe AutoAccept
autoAccept' = (\AutoAccept
aa -> AutoAccept
aa {acceptIncognito = False}) (AutoAccept -> AutoAccept) -> Maybe AutoAccept -> Maybe AutoAccept
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AddressSettings -> Maybe AutoAccept
autoAccept AddressSettings
addressSettings
          ucl' :: UserContactLink
ucl' = (UserContactLink
ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, shortLinkLargeDataSet = BoolDef True, addressSettings = addressSettings {autoAccept = autoAccept'}}
      UserContactLink
-> ExceptT ChatError (ReaderT ChatController IO) UserContactLink
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserContactLink
ucl'
    updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse
    updateContactPrefs :: User -> Contact -> Preferences -> CM ChatResponse
updateContactPrefs User
_ ct :: Contact
ct@Contact {activeConn :: Contact -> Maybe Connection
activeConn = Maybe Connection
Nothing} Preferences
_ = ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Contact -> ChatErrorType
CEContactNotActive Contact
ct
    updateContactPrefs user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} ct :: Contact
ct@Contact {activeConn :: Contact -> Maybe Connection
activeConn = Just Connection {Maybe Int64
customUserProfileId :: Connection -> Maybe Int64
customUserProfileId :: Maybe Int64
customUserProfileId}, userPreferences :: Contact -> Preferences
userPreferences = Preferences
contactUserPrefs} Preferences
contactUserPrefs'
      | Preferences
contactUserPrefs Preferences -> Preferences -> Bool
forall a. Eq a => a -> a -> Bool
== Preferences
contactUserPrefs' = ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Contact -> ChatResponse
CRContactPrefsUpdated User
user Contact
ct Contact
ct
      | Bool
otherwise = do
          User
-> MsgDirection
-> Contact
-> CMEventTag 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (e :: MsgEncoding).
User
-> MsgDirection
-> Contact
-> CMEventTag e
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDirectAllowed User
user MsgDirection
MDSnd Contact
ct CMEventTag 'Json
XInfo_
          Contact
ct' <- (Connection -> IO Contact) -> CM Contact
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO Contact) -> CM Contact)
-> (Connection -> IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> Preferences -> IO Contact
updateContactUserPreferences Connection
db User
user Contact
ct Preferences
contactUserPrefs'
          Maybe LocalProfile
incognitoProfile <- Maybe Int64
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Int64
customUserProfileId ((Int64
  -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe LocalProfile))
-> (Int64
    -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe LocalProfile)
forall a b. (a -> b) -> a -> b
$ \Int64
profileId -> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO LocalProfile)
 -> ExceptT ChatError (ReaderT ChatController IO) LocalProfile)
-> (Connection -> ExceptT StoreError IO LocalProfile)
-> ExceptT ChatError (ReaderT ChatController IO) LocalProfile
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> Int64 -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById Connection
db Int64
userId Int64
profileId
          let mergedProfile :: Profile
mergedProfile = User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user (LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> Maybe LocalProfile -> Maybe Profile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalProfile
incognitoProfile) (Contact -> Maybe Contact
forall a. a -> Maybe a
Just Contact
ct) Bool
False
              mergedProfile' :: Profile
mergedProfile' = User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
userProfileDirect User
user (LocalProfile -> Profile
fromLocalProfile (LocalProfile -> Profile) -> Maybe LocalProfile -> Maybe Profile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LocalProfile
incognitoProfile) (Contact -> Maybe Contact
forall a. a -> Maybe a
Just Contact
ct') Bool
False
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Profile
mergedProfile' Profile -> Profile -> Bool
forall a. Eq a => a -> a -> Bool
/= Profile
mergedProfile) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
            Text
-> Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"updateContactPrefs" (Contact -> Int64
forall a. IsContact a => a -> Int64
contactId' Contact
ct) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
              CM (SndMessage, Int64)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct' (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall a b. (a -> b) -> a -> b
$ Profile -> ChatMsgEvent 'Json
XInfo Profile
mergedProfile') ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
              ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Contact -> Bool
directOrUsed Contact
ct') (ReaderT ChatController IO ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Contact -> ReaderT ChatController IO ()
createSndFeatureItems User
user Contact
ct Contact
ct'
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> Contact -> Contact -> ChatResponse
CRContactPrefsUpdated User
user Contact
ct Contact
ct'
    runUpdateGroupProfile :: User -> GroupInfo -> GroupProfile -> CM ChatResponse
    runUpdateGroupProfile :: User -> GroupInfo -> GroupProfile -> CM ChatResponse
runUpdateGroupProfile User
user gInfo :: GroupInfo
gInfo@GroupInfo {Maybe BusinessChatInfo
businessChat :: Maybe BusinessChatInfo
businessChat :: GroupInfo -> Maybe BusinessChatInfo
businessChat, groupProfile :: GroupInfo -> GroupProfile
groupProfile = p :: GroupProfile
p@GroupProfile {displayName :: GroupProfile -> Text
displayName = Text
n}} p' :: GroupProfile
p'@GroupProfile {displayName :: GroupProfile -> Text
displayName = Text
n'} = do
      GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo GroupMemberRole
GROwner
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
n') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT ChatError (ReaderT ChatController IO) ()
checkValidName Text
n'
      GroupInfo
gInfo' <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> GroupInfo
-> GroupProfile
-> ExceptT StoreError IO GroupInfo
updateGroupProfile Connection
db User
user GroupInfo
gInfo GroupProfile
p'
      SndMessage
msg <- case Maybe BusinessChatInfo
businessChat of
        Just BusinessChatInfo {MemberId
businessId :: MemberId
businessId :: BusinessChatInfo -> MemberId
businessId} -> do
          [GroupMember]
ms <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo'
          let ([GroupMember]
newMs, [GroupMember]
oldMs) = (GroupMember -> Bool)
-> [GroupMember] -> ([GroupMember], [GroupMember])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\GroupMember
m -> VersionRangeChat -> Version ChatVersion
forall v. VersionRange v -> Version v
maxVersion (GroupMember -> VersionRangeChat
memberChatVRange GroupMember
m) Version ChatVersion -> Version ChatVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Version ChatVersion
businessChatPrefsVersion) [GroupMember]
ms
          -- this is a fallback to send the members with the old version correct profile of the business when preferences change
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GroupMember] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GroupMember]
oldMs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
            GroupMember {memberProfile :: GroupMember -> LocalProfile
memberProfile = LocalProfile {Text
displayName :: LocalProfile -> Text
displayName :: Text
displayName, Text
fullName :: Text
fullName :: LocalProfile -> Text
fullName, Maybe Text
shortDescr :: Maybe Text
shortDescr :: LocalProfile -> Maybe Text
shortDescr, Maybe ImageData
image :: Maybe ImageData
image :: LocalProfile -> Maybe ImageData
image}} <-
              (Connection -> ExceptT StoreError IO GroupMember) -> CM GroupMember
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO GroupMember)
 -> CM GroupMember)
-> (Connection -> ExceptT StoreError IO GroupMember)
-> CM GroupMember
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> GroupInfo
-> MemberId
-> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo' MemberId
businessId
            let p'' :: GroupProfile
p'' = GroupProfile
p' {displayName, fullName, shortDescr, image} :: GroupProfile
                recipients :: [GroupMember]
recipients = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrentOrPending [GroupMember]
oldMs
            CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CM SndMessage -> ExceptT ChatError (ReaderT ChatController IO) ())
-> CM SndMessage
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent e
-> CM SndMessage
sendGroupMessage User
user GroupInfo
gInfo' Maybe GroupChatScope
forall a. Maybe a
Nothing [GroupMember]
recipients (GroupProfile -> ChatMsgEvent 'Json
XGrpInfo GroupProfile
p'')
          let ps' :: GroupPreferences
ps' = GroupPreferences -> Maybe GroupPreferences -> GroupPreferences
forall a. a -> Maybe a -> a
fromMaybe GroupPreferences
defaultBusinessGroupPrefs (Maybe GroupPreferences -> GroupPreferences)
-> Maybe GroupPreferences -> GroupPreferences
forall a b. (a -> b) -> a -> b
$ GroupProfile -> Maybe GroupPreferences
groupPreferences GroupProfile
p'
              recipients :: [GroupMember]
recipients = (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrentOrPending [GroupMember]
newMs
          User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent e
-> CM SndMessage
sendGroupMessage User
user GroupInfo
gInfo' Maybe GroupChatScope
forall a. Maybe a
Nothing [GroupMember]
recipients (ChatMsgEvent 'Json -> CM SndMessage)
-> ChatMsgEvent 'Json -> CM SndMessage
forall a b. (a -> b) -> a -> b
$ GroupPreferences -> ChatMsgEvent 'Json
XGrpPrefs GroupPreferences
ps'
        Maybe BusinessChatInfo
Nothing -> do
          NetworkRequestMode
-> User
-> GroupInfo
-> ExceptT ChatError (ReaderT ChatController IO) ()
setGroupLinkData' NetworkRequestMode
nm User
user GroupInfo
gInfo'
          [GroupMember]
recipients <- CM [GroupMember]
getRecipients
          User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent 'Json
-> CM SndMessage
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> ChatMsgEvent e
-> CM SndMessage
sendGroupMessage User
user GroupInfo
gInfo' Maybe GroupChatScope
forall a. Maybe a
Nothing [GroupMember]
recipients (GroupProfile -> ChatMsgEvent 'Json
XGrpInfo GroupProfile
p')
          where
            getRecipients :: CM [GroupMember]
getRecipients
              | BoolDef -> Bool
isTrue (GroupInfo -> BoolDef
useRelays GroupInfo
gInfo') = (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupRelays Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo'
              | Bool
otherwise = do
                  [GroupMember]
ms <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo'
                  [GroupMember] -> CM [GroupMember]
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GroupMember] -> CM [GroupMember])
-> [GroupMember] -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ (GroupMember -> Bool) -> [GroupMember] -> [GroupMember]
forall a. (a -> Bool) -> [a] -> [a]
filter GroupMember -> Bool
memberCurrentOrPending [GroupMember]
ms
      let cd :: ChatDirection 'CTGroup 'MDSnd
cd = GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo' Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GroupProfile -> GroupProfile -> Bool
sameGroupProfileInfo GroupProfile
p GroupProfile
p') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
        ChatItem 'CTGroup 'MDSnd
ci <- User
-> ChatDirection 'CTGroup 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem 'CTGroup 'MDSnd)
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> CM (ChatItem c 'MDSnd)
saveSndChatItem User
user ChatDirection 'CTGroup 'MDSnd
cd SndMessage
msg (SndGroupEvent -> CIContent 'MDSnd
CISndGroupEvent (SndGroupEvent -> CIContent 'MDSnd)
-> SndGroupEvent -> CIContent 'MDSnd
forall a b. (a -> b) -> a -> b
$ GroupProfile -> SndGroupEvent
SGEGroupUpdated GroupProfile
p')
        ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo' Maybe GroupChatScopeInfo
forall a. Maybe a
Nothing) ChatItem 'CTGroup 'MDSnd
ci]
      User
-> ChatDirection 'CTGroup 'MDSnd
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent 'MDSnd)
-> GroupInfo
-> GroupInfo
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (d :: MsgDirection).
MsgDirectionI d =>
User
-> ChatDirection 'CTGroup d
-> (GroupFeature
    -> GroupPreference
    -> Maybe Int
    -> Maybe GroupMemberRole
    -> CIContent d)
-> GroupInfo
-> GroupInfo
-> ExceptT ChatError (ReaderT ChatController IO) ()
createGroupFeatureChangedItems User
user ChatDirection 'CTGroup 'MDSnd
cd GroupFeature
-> GroupPreference
-> Maybe Int
-> Maybe GroupMemberRole
-> CIContent 'MDSnd
CISndGroupFeature GroupInfo
gInfo GroupInfo
gInfo'
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> GroupInfo -> GroupInfo -> Maybe GroupMember -> ChatResponse
CRGroupUpdated User
user GroupInfo
gInfo GroupInfo
gInfo' Maybe GroupMember
forall a. Maybe a
Nothing
    checkValidName :: GroupName -> CM ()
    checkValidName :: Text -> ExceptT ChatError (ReaderT ChatController IO) ()
checkValidName Text
displayName = do
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
displayName) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError CEInvalidDisplayName {Text
displayName :: Text
displayName :: Text
displayName, validName :: Text
validName = Text
""}
      let validName :: Text
validName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
mkValidName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
displayName
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
displayName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
validName) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError CEInvalidDisplayName {Text
displayName :: Text
displayName :: Text
displayName, Text
validName :: Text
validName :: Text
validName}
    assertUserGroupRole :: GroupInfo -> GroupMemberRole -> CM ()
    assertUserGroupRole :: GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole g :: GroupInfo
g@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} GroupMemberRole
requiredRole = do
      let GroupMember {memberRole :: GroupMember -> GroupMemberRole
memberRole = GroupMemberRole
membershipMemRole} = GroupMember
membership
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMemberRole
membershipMemRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
< GroupMemberRole
requiredRole) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatErrorType
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupMemberRole -> ChatErrorType
CEGroupUserRole GroupInfo
g GroupMemberRole
requiredRole
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMember -> GroupMemberStatus
memberStatus GroupMember
membership GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberStatus
GSMemInvited) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (GroupInfo -> ChatErrorType
CEGroupNotJoined GroupInfo
g)
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GroupMember -> Bool
memberRemoved GroupMember
membership) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberUserRemoved
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (GroupMember -> Bool
memberActive GroupMember
membership) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEGroupMemberNotActive
    delGroupChatItemsForMembers :: User -> GroupInfo -> Maybe GroupChatScopeInfo -> [GroupMember] -> [CChatItem 'CTGroup] -> CM [ChatItemDeletion]
    delGroupChatItemsForMembers :: User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> [CChatItem 'CTGroup]
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
delGroupChatItemsForMembers User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [GroupMember]
ms [CChatItem 'CTGroup]
items = do
      GroupInfo
-> [CChatItem 'CTGroup]
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDeletable GroupInfo
gInfo [CChatItem 'CTGroup]
items
      GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo GroupMemberRole
GRModerator
      let msgMemIds :: [(SharedMsgId, MemberId)]
msgMemIds = GroupInfo -> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)]
itemsMsgMemIds GroupInfo
gInfo [CChatItem 'CTGroup]
items
          events :: Maybe (NonEmpty (ChatMsgEvent 'Json))
events = [ChatMsgEvent 'Json] -> Maybe (NonEmpty (ChatMsgEvent 'Json))
forall a. [a] -> Maybe (NonEmpty a)
L.nonEmpty ([ChatMsgEvent 'Json] -> Maybe (NonEmpty (ChatMsgEvent 'Json)))
-> [ChatMsgEvent 'Json] -> Maybe (NonEmpty (ChatMsgEvent 'Json))
forall a b. (a -> b) -> a -> b
$ ((SharedMsgId, MemberId) -> ChatMsgEvent 'Json)
-> [(SharedMsgId, MemberId)] -> [ChatMsgEvent 'Json]
forall a b. (a -> b) -> [a] -> [b]
map (\(SharedMsgId
msgId, MemberId
memId) -> SharedMsgId
-> Maybe MemberId -> Maybe MsgScope -> ChatMsgEvent 'Json
XMsgDel SharedMsgId
msgId (MemberId -> Maybe MemberId
forall a. a -> Maybe a
Just MemberId
memId) (Maybe MsgScope -> ChatMsgEvent 'Json)
-> Maybe MsgScope -> ChatMsgEvent 'Json
forall a b. (a -> b) -> a -> b
$ GroupInfo -> GroupChatScopeInfo -> MsgScope
toMsgScope GroupInfo
gInfo (GroupChatScopeInfo -> MsgScope)
-> Maybe GroupChatScopeInfo -> Maybe MsgScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupChatScopeInfo
chatScopeInfo) [(SharedMsgId, MemberId)]
msgMemIds
      (NonEmpty (ChatMsgEvent 'Json)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (Either ChatError SndMessage), GroupSndResult))
-> Maybe (NonEmpty (ChatMsgEvent 'Json))
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (User
-> GroupInfo
-> [GroupMember]
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> [GroupMember]
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages_ User
user GroupInfo
gInfo [GroupMember]
ms) Maybe (NonEmpty (ChatMsgEvent 'Json))
events
      User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
delGroupChatItems User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [CChatItem 'CTGroup]
items Bool
True
      where
        assertDeletable :: GroupInfo -> [CChatItem 'CTGroup] -> CM ()
        assertDeletable :: GroupInfo
-> [CChatItem 'CTGroup]
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDeletable GroupInfo {membership :: GroupInfo -> GroupMember
membership = GroupMember {memberRole :: GroupMember -> GroupMemberRole
memberRole = GroupMemberRole
membershipMemRole}} [CChatItem 'CTGroup]
items' =
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((CChatItem 'CTGroup -> Bool) -> [CChatItem 'CTGroup] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CChatItem 'CTGroup -> Bool
itemDeletable [CChatItem 'CTGroup]
items') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidChatItemDelete
          where
            itemDeletable :: CChatItem 'CTGroup -> Bool
            itemDeletable :: CChatItem 'CTGroup -> Bool
itemDeletable (CChatItem SMsgDirection d
_ ChatItem {CIDirection 'CTGroup d
chatDir :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIDirection c d
chatDir :: CIDirection 'CTGroup d
chatDir, meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}}) =
              case CIDirection 'CTGroup d
chatDir of
                CIGroupRcv GroupMember {GroupMemberRole
memberRole :: GroupMember -> GroupMemberRole
memberRole :: GroupMemberRole
memberRole} -> GroupMemberRole
membershipMemRole GroupMemberRole -> GroupMemberRole -> Bool
forall a. Ord a => a -> a -> Bool
>= GroupMemberRole
memberRole Bool -> Bool -> Bool
&& Maybe SharedMsgId -> Bool
forall a. Maybe a -> Bool
isJust Maybe SharedMsgId
itemSharedMsgId
                CIDirection 'CTGroup d
CIGroupSnd -> Maybe SharedMsgId -> Bool
forall a. Maybe a -> Bool
isJust Maybe SharedMsgId
itemSharedMsgId
        itemsMsgMemIds :: GroupInfo -> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)]
        itemsMsgMemIds :: GroupInfo -> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)]
itemsMsgMemIds GroupInfo {membership :: GroupInfo -> GroupMember
membership = GroupMember {memberId :: GroupMember -> MemberId
memberId = MemberId
membershipMemId}} = (CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId))
-> [CChatItem 'CTGroup] -> [(SharedMsgId, MemberId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId)
itemMsgMemIds
          where
            itemMsgMemIds :: CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId)
            itemMsgMemIds :: CChatItem 'CTGroup -> Maybe (SharedMsgId, MemberId)
itemMsgMemIds (CChatItem SMsgDirection d
_ ChatItem {CIDirection 'CTGroup d
chatDir :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIDirection c d
chatDir :: CIDirection 'CTGroup d
chatDir, meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}}) =
              Maybe (Maybe (SharedMsgId, MemberId))
-> Maybe (SharedMsgId, MemberId)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (SharedMsgId, MemberId))
 -> Maybe (SharedMsgId, MemberId))
-> ((SharedMsgId -> Maybe (SharedMsgId, MemberId))
    -> Maybe (Maybe (SharedMsgId, MemberId)))
-> (SharedMsgId -> Maybe (SharedMsgId, MemberId))
-> Maybe (SharedMsgId, MemberId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SharedMsgId
-> (SharedMsgId -> Maybe (SharedMsgId, MemberId))
-> Maybe (Maybe (SharedMsgId, MemberId))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe SharedMsgId
itemSharedMsgId ((SharedMsgId -> Maybe (SharedMsgId, MemberId))
 -> Maybe (SharedMsgId, MemberId))
-> (SharedMsgId -> Maybe (SharedMsgId, MemberId))
-> Maybe (SharedMsgId, MemberId)
forall a b. (a -> b) -> a -> b
$ \SharedMsgId
msgId -> (SharedMsgId, MemberId) -> Maybe (SharedMsgId, MemberId)
forall a. a -> Maybe a
Just ((SharedMsgId, MemberId) -> Maybe (SharedMsgId, MemberId))
-> (SharedMsgId, MemberId) -> Maybe (SharedMsgId, MemberId)
forall a b. (a -> b) -> a -> b
$ case CIDirection 'CTGroup d
chatDir of
                CIGroupRcv GroupMember {MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId} -> (SharedMsgId
msgId, MemberId
memberId)
                CIDirection 'CTGroup d
CIGroupSnd -> (SharedMsgId
msgId, MemberId
membershipMemId)

    delGroupChatItems :: User -> GroupInfo -> Maybe GroupChatScopeInfo -> [CChatItem 'CTGroup] -> Bool -> CM [ChatItemDeletion]
    delGroupChatItems :: User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
delGroupChatItems User
user gInfo :: GroupInfo
gInfo@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} Maybe GroupChatScopeInfo
chatScopeInfo [CChatItem 'CTGroup]
items Bool
moderation = do
      UTCTime
deletedTs <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
moderation (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
        [Int64]
ciIds <- [[Int64]] -> [Int64]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int64]] -> [Int64])
-> ExceptT ChatError (ReaderT ChatController IO) [[Int64]]
-> ExceptT ChatError (ReaderT ChatController IO) [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [[Int64]])
-> ExceptT ChatError (ReaderT ChatController IO) [[Int64]]
forall a. (Connection -> IO a) -> CM a
withStore' (\Connection
db -> [CChatItem 'CTGroup]
-> (CChatItem 'CTGroup -> IO [Int64]) -> IO [[Int64]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CChatItem 'CTGroup]
items ((CChatItem 'CTGroup -> IO [Int64]) -> IO [[Int64]])
-> (CChatItem 'CTGroup -> IO [Int64]) -> IO [[Int64]]
forall a b. (a -> b) -> a -> b
$ \(CChatItem SMsgDirection d
_ ChatItem 'CTGroup d
ci) -> Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup d
-> GroupMember
-> UTCTime
-> IO [Int64]
forall (d :: MsgDirection).
Connection
-> User
-> GroupInfo
-> ChatItem 'CTGroup d
-> GroupMember
-> UTCTime
-> IO [Int64]
markMessageReportsDeleted Connection
db User
user GroupInfo
gInfo ChatItem 'CTGroup d
ci GroupMember
membership UTCTime
deletedTs)
        Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int64] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int64]
ciIds) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> GroupInfo -> [Int64] -> Bool -> Maybe GroupMember -> ChatEvent
CEvtGroupChatItemsDeleted User
user GroupInfo
gInfo [Int64]
ciIds Bool
True (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
membership)
      let m :: Maybe GroupMember
m = if Bool
moderation then GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
membership else Maybe GroupMember
forall a. Maybe a
Nothing
      if SGroupFeature 'GFFullDelete -> GroupInfo -> Bool
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> GroupInfo -> Bool
groupFeatureUserAllowed SGroupFeature 'GFFullDelete
SGFFullDelete GroupInfo
gInfo
        then User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Maybe GroupMember
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
deleteGroupCIs User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [CChatItem 'CTGroup]
items Maybe GroupMember
m UTCTime
deletedTs
        else User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> [CChatItem 'CTGroup]
-> Maybe GroupMember
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) [ChatItemDeletion]
markGroupCIsDeleted User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo [CChatItem 'CTGroup]
items Maybe GroupMember
m UTCTime
deletedTs
    updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse
    updateGroupProfileByName :: Text -> (GroupProfile -> GroupProfile) -> CM ChatResponse
updateGroupProfileByName Text
gName GroupProfile -> GroupProfile
update = (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
      gInfo :: GroupInfo
gInfo@GroupInfo {groupProfile :: GroupInfo -> GroupProfile
groupProfile = GroupProfile
p} <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
        Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName ExceptT StoreError IO Int64
-> (Int64 -> ExceptT StoreError IO GroupInfo)
-> ExceptT StoreError IO GroupInfo
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user
      User -> GroupInfo -> GroupProfile -> CM ChatResponse
runUpdateGroupProfile User
user GroupInfo
gInfo (GroupProfile -> CM ChatResponse)
-> GroupProfile -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ GroupProfile -> GroupProfile
update GroupProfile
p
    withCurrentCall :: ContactId -> (User -> Contact -> Call -> CM (Maybe Call)) -> CM ChatResponse
    withCurrentCall :: Int64
-> (User
    -> Contact
    -> Call
    -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call))
-> CM ChatResponse
withCurrentCall Int64
ctId User
-> Contact
-> Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
action = do
      (User
user, Contact
ct) <- (Connection -> ExceptT StoreError IO (User, Contact))
-> CM (User, Contact)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO (User, Contact))
 -> CM (User, Contact))
-> (Connection -> ExceptT StoreError IO (User, Contact))
-> CM (User, Contact)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        User
user <- Connection -> Int64 -> ExceptT StoreError IO User
getUserByContactId Connection
db Int64
ctId
        (User
user,) (Contact -> (User, Contact))
-> ExceptT StoreError IO Contact
-> ExceptT StoreError IO (User, Contact)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
ctId
      TMap Int64 Call
calls <- (ChatController -> TMap Int64 Call)
-> ExceptT ChatError (ReaderT ChatController IO) (TMap Int64 Call)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Call
currentCalls
      Text -> Int64 -> CM ChatResponse -> CM ChatResponse
forall a. Text -> Int64 -> CM a -> CM a
withContactLock Text
"currentCall" Int64
ctId (CM ChatResponse -> CM ChatResponse)
-> CM ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$
        STM (Maybe Call)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (Int64 -> TMap Int64 Call -> STM (Maybe Call)
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookup Int64
ctId TMap Int64 Call
calls) ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
-> (Maybe Call -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Call
Nothing -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CENoCurrentCall
          Just call :: Call
call@Call {Int64
contactId :: Call -> Int64
contactId :: Int64
contactId}
            | Int64
ctId Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
contactId -> do
                Maybe Call
call_ <- User
-> Contact
-> Call
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Call)
action User
user Contact
ct Call
call
                case Maybe Call
call_ of
                  Just Call
call' -> do
                    Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Call -> Bool
isRcvInvitation Call
call') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> IO ()
deleteCalls Connection
db User
user Int64
ctId
                    STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Call -> TMap Int64 Call -> STM ()
forall k a. Ord k => k -> a -> TMap k a -> STM ()
TM.insert Int64
ctId Call
call' TMap Int64 Call
calls
                  Maybe Call
_ -> do
                    (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> IO ()
deleteCalls Connection
db User
user Int64
ctId
                    STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> TMap Int64 Call -> STM ()
forall k a. Ord k => k -> TMap k a -> STM ()
TM.delete Int64
ctId TMap Int64 Call
calls
                User -> CM ChatResponse
ok User
user
            | Bool
otherwise -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatErrorType
CECallContact Int64
contactId
    withServerProtocol :: ProtocolTypeI p => SProtocolType p -> (UserProtocol p => CM a) -> CM a
    withServerProtocol :: forall (p :: ProtocolType) a.
ProtocolTypeI p =>
SProtocolType p -> (UserProtocol p => CM a) -> CM a
withServerProtocol SProtocolType p
p UserProtocol p => CM a
action = case SProtocolType p -> Maybe (Dict (UserProtocol p))
forall (p :: ProtocolType).
SProtocolType p -> Maybe (Dict (UserProtocol p))
userProtocol SProtocolType p
p of
      Just Dict (UserProtocol p)
Dict -> CM a
UserProtocol p => CM a
action
      Maybe (Dict (UserProtocol p))
_ -> ChatErrorType -> CM a
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM a) -> ChatErrorType -> CM a
forall a b. (a -> b) -> a -> b
$ AProtocolType -> ChatErrorType
CEServerProtocol (AProtocolType -> ChatErrorType) -> AProtocolType -> ChatErrorType
forall a b. (a -> b) -> a -> b
$ SProtocolType p -> AProtocolType
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> AProtocolType
AProtocolType SProtocolType p
p
    validateAllUsersServers :: UserServersClass u => Int64 -> [u] -> CM [UserServersError]
    validateAllUsersServers :: forall u.
UserServersClass u =>
Int64 -> [u] -> CM [UserServersError]
validateAllUsersServers Int64
currUserId [u]
userServers = (Connection -> ExceptT StoreError IO [UserServersError])
-> CM [UserServersError]
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO [UserServersError])
 -> CM [UserServersError])
-> (Connection -> ExceptT StoreError IO [UserServersError])
-> CM [UserServersError]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
      [User]
users' <- (User -> Bool) -> [User] -> [User]
forall a. (a -> Bool) -> [a] -> [a]
filter (\User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> Int64
userId Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
currUserId) ([User] -> [User])
-> ExceptT StoreError IO [User] -> ExceptT StoreError IO [User]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [User] -> ExceptT StoreError IO [User]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> IO [User]
getUsers Connection
db)
      [(User, [UserOperatorServers])]
others <- (User -> ExceptT StoreError IO (User, [UserOperatorServers]))
-> [User] -> ExceptT StoreError IO [(User, [UserOperatorServers])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Connection
-> User -> ExceptT StoreError IO (User, [UserOperatorServers])
getUserOperatorServers Connection
db) [User]
users'
      [UserServersError] -> ExceptT StoreError IO [UserServersError]
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([UserServersError] -> ExceptT StoreError IO [UserServersError])
-> [UserServersError] -> ExceptT StoreError IO [UserServersError]
forall a b. (a -> b) -> a -> b
$ [u] -> [(User, [UserOperatorServers])] -> [UserServersError]
forall u'.
UserServersClass u' =>
[u'] -> [(User, [UserOperatorServers])] -> [UserServersError]
validateUserServers [u]
userServers [(User, [UserOperatorServers])]
others
      where
        getUserOperatorServers :: DB.Connection -> User -> ExceptT StoreError IO (User, [UserOperatorServers])
        getUserOperatorServers :: Connection
-> User -> ExceptT StoreError IO (User, [UserOperatorServers])
getUserOperatorServers Connection
db User
user = do
          [UserOperatorServers]
uss <- IO [UserOperatorServers]
-> ExceptT StoreError IO [UserOperatorServers]
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [UserOperatorServers]
 -> ExceptT StoreError IO [UserOperatorServers])
-> (([Maybe ServerOperator], [UserServer 'PSMP],
     [UserServer 'PXFTP])
    -> IO [UserOperatorServers])
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
-> ExceptT StoreError IO [UserOperatorServers]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> IO [UserOperatorServers]
groupByOperator (([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
 -> ExceptT StoreError IO [UserOperatorServers])
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
-> ExceptT StoreError IO [UserOperatorServers]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Connection
-> User
-> ExceptT
     StoreError
     IO
     ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
getUserServers Connection
db User
user
          (User, [UserOperatorServers])
-> ExceptT StoreError IO (User, [UserOperatorServers])
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (User
user, (UserOperatorServers -> UserOperatorServers)
-> [UserOperatorServers] -> [UserOperatorServers]
forall a b. (a -> b) -> [a] -> [b]
map UserOperatorServers -> UserOperatorServers
updatedUserSrvs [UserOperatorServers]
uss)
        updatedUserSrvs :: UserOperatorServers -> UserOperatorServers
updatedUserSrvs UserOperatorServers
uss = UserOperatorServers
uss {operator = updatedOp <$> operator' uss} :: UserOperatorServers
        updatedOp :: ServerOperator -> ServerOperator
updatedOp ServerOperator
op = ServerOperator -> Maybe ServerOperator -> ServerOperator
forall a. a -> Maybe a -> a
fromMaybe ServerOperator
op (Maybe ServerOperator -> ServerOperator)
-> Maybe ServerOperator -> ServerOperator
forall a b. (a -> b) -> a -> b
$ (ServerOperator -> Bool)
-> [ServerOperator] -> Maybe ServerOperator
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ServerOperator -> Bool
matchingOp ([ServerOperator] -> Maybe ServerOperator)
-> [ServerOperator] -> Maybe ServerOperator
forall a b. (a -> b) -> a -> b
$ (u -> Maybe ServerOperator) -> [u] -> [ServerOperator]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe u -> Maybe ServerOperator
forall u. UserServersClass u => u -> Maybe ServerOperator
operator' [u]
userServers
          where
            matchingOp :: ServerOperator -> Bool
matchingOp ServerOperator
op' = ServerOperator -> DBEntityId' 'DBStored
forall (s :: DBStored). ServerOperator' s -> DBEntityId' s
operatorId ServerOperator
op' DBEntityId' 'DBStored -> DBEntityId' 'DBStored -> Bool
forall a. Eq a => a -> a -> Bool
== ServerOperator -> DBEntityId' 'DBStored
forall (s :: DBStored). ServerOperator' s -> DBEntityId' s
operatorId ServerOperator
op
    forwardFile :: ChatName -> FileTransferId -> (ChatName -> CryptoFile -> ChatCommand) -> CM ChatResponse
    forwardFile :: ChatName
-> Int64
-> (ChatName -> CryptoFile -> ChatCommand)
-> CM ChatResponse
forwardFile ChatName
chatName Int64
fileId ChatName -> CryptoFile -> ChatCommand
sendCommand = (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
      (Connection -> ExceptT StoreError IO FileTransfer)
-> CM FileTransfer
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore (\Connection
db -> Connection -> User -> Int64 -> ExceptT StoreError IO FileTransfer
getFileTransfer Connection
db User
user Int64
fileId) CM FileTransfer
-> (FileTransfer -> CM ChatResponse) -> CM ChatResponse
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        FTRcv RcvFileTransfer {fileStatus :: RcvFileTransfer -> RcvFileStatus
fileStatus = RFSComplete String
filePath, Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs :: RcvFileTransfer -> Maybe CryptoFileArgs
cryptoArgs} -> String -> Maybe CryptoFileArgs -> CM ChatResponse
forward String
filePath Maybe CryptoFileArgs
cryptoArgs
        FTSnd {fileTransferMeta :: FileTransfer -> FileTransferMeta
fileTransferMeta = FileTransferMeta {String
filePath :: String
filePath :: FileTransferMeta -> String
filePath, Maybe XFTPSndFile
xftpSndFile :: FileTransferMeta -> Maybe XFTPSndFile
xftpSndFile :: Maybe XFTPSndFile
xftpSndFile}} -> String -> Maybe CryptoFileArgs -> CM ChatResponse
forward String
filePath (Maybe CryptoFileArgs -> CM ChatResponse)
-> Maybe CryptoFileArgs -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Maybe XFTPSndFile
xftpSndFile Maybe XFTPSndFile
-> (XFTPSndFile -> Maybe CryptoFileArgs) -> Maybe CryptoFileArgs
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XFTPSndFile {Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs :: XFTPSndFile -> Maybe CryptoFileArgs
cryptoArgs} -> Maybe CryptoFileArgs
cryptoArgs
        FileTransfer
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError CEFileNotReceived {Int64
fileId :: Int64
fileId :: Int64
fileId}
      where
        forward :: String -> Maybe CryptoFileArgs -> CM ChatResponse
forward String
path Maybe CryptoFileArgs
cfArgs = VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatName -> CryptoFile -> ChatCommand
sendCommand ChatName
chatName (CryptoFile -> ChatCommand) -> CryptoFile -> ChatCommand
forall a b. (a -> b) -> a -> b
$ String -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile String
path Maybe CryptoFileArgs
cfArgs
    getGroupAndMemberId :: User -> GroupName -> ContactName -> CM (GroupId, GroupMemberId)
    getGroupAndMemberId :: User -> Text -> Text -> CM (Int64, Int64)
getGroupAndMemberId User
user Text
gName Text
groupMemberName =
      (Connection -> ExceptT StoreError IO (Int64, Int64))
-> CM (Int64, Int64)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO (Int64, Int64))
 -> CM (Int64, Int64))
-> (Connection -> ExceptT StoreError IO (Int64, Int64))
-> CM (Int64, Int64)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
        Int64
groupId <- Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
gName
        Int64
groupMemberId <- Connection -> User -> Int64 -> Text -> ExceptT StoreError IO Int64
getGroupMemberIdByName Connection
db User
user Int64
groupId Text
groupMemberName
        (Int64, Int64) -> ExceptT StoreError IO (Int64, Int64)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
groupId, Int64
groupMemberId)
    sendGrpInvitation :: User -> Contact -> GroupInfo -> GroupMember -> ConnReqInvitation -> CM ()
    sendGrpInvitation :: User
-> Contact
-> GroupInfo
-> GroupMember
-> ConnReqInvitation
-> ExceptT ChatError (ReaderT ChatController IO) ()
sendGrpInvitation User
user ct :: Contact
ct@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId, Text
localDisplayName :: Contact -> Text
localDisplayName :: Text
localDisplayName} gInfo :: GroupInfo
gInfo@GroupInfo {Int64
groupId :: GroupInfo -> Int64
groupId :: Int64
groupId, GroupProfile
groupProfile :: GroupInfo -> GroupProfile
groupProfile :: GroupProfile
groupProfile, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership, Maybe BusinessChatInfo
businessChat :: GroupInfo -> Maybe BusinessChatInfo
businessChat :: Maybe BusinessChatInfo
businessChat} GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId, MemberId
memberId :: GroupMember -> MemberId
memberId :: MemberId
memberId, memberRole :: GroupMember -> GroupMemberRole
memberRole = GroupMemberRole
memRole} ConnReqInvitation
cReq = do
      Int
currentMemCount <- (Connection -> IO Int) -> CM Int
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO Int) -> CM Int)
-> (Connection -> IO Int) -> CM Int
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> IO Int
getGroupCurrentMembersCount Connection
db User
user GroupInfo
gInfo
      let GroupMember {memberRole :: GroupMember -> GroupMemberRole
memberRole = GroupMemberRole
userRole, memberId :: GroupMember -> MemberId
memberId = MemberId
userMemberId} = GroupMember
membership
          groupInv :: GroupInvitation
groupInv =
            GroupInvitation
              { fromMember :: MemberIdRole
fromMember = MemberId -> GroupMemberRole -> MemberIdRole
MemberIdRole MemberId
userMemberId GroupMemberRole
userRole,
                invitedMember :: MemberIdRole
invitedMember = MemberId -> GroupMemberRole -> MemberIdRole
MemberIdRole MemberId
memberId GroupMemberRole
memRole,
                connRequest :: ConnReqInvitation
connRequest = ConnReqInvitation
cReq,
                GroupProfile
groupProfile :: GroupProfile
groupProfile :: GroupProfile
groupProfile,
                business :: Maybe BusinessChatInfo
business = Maybe BusinessChatInfo
businessChat,
                groupLinkId :: Maybe GroupLinkId
groupLinkId = Maybe GroupLinkId
forall a. Maybe a
Nothing,
                groupSize :: Maybe Int
groupSize = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
currentMemCount
              }
      (SndMessage
msg, Int64
_) <- User -> Contact -> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User -> Contact -> ChatMsgEvent e -> CM (SndMessage, Int64)
sendDirectContactMessage User
user Contact
ct (ChatMsgEvent 'Json -> CM (SndMessage, Int64))
-> ChatMsgEvent 'Json -> CM (SndMessage, Int64)
forall a b. (a -> b) -> a -> b
$ GroupInvitation -> ChatMsgEvent 'Json
XGrpInv GroupInvitation
groupInv
      let content :: CIContent 'MDSnd
content = CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd
CISndGroupInvitation (CIGroupInvitation {Int64
groupId :: Int64
groupId :: Int64
groupId, Int64
groupMemberId :: Int64
groupMemberId :: Int64
groupMemberId, Text
localDisplayName :: Text
localDisplayName :: Text
localDisplayName, GroupProfile
groupProfile :: GroupProfile
groupProfile :: GroupProfile
groupProfile, status :: CIGroupInvitationStatus
status = CIGroupInvitationStatus
CIGISPending}) GroupMemberRole
memRole
      Maybe CITimed
timed_ <- Contact -> CM (Maybe CITimed)
contactCITimed Contact
ct
      ChatItem 'CTDirect 'MDSnd
ci <- User
-> ChatDirection 'CTDirect 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote 'CTDirect)
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> CM (ChatItem 'CTDirect 'MDSnd)
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> SndMessage
-> CIContent 'MDSnd
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> Maybe CITimed
-> Bool
-> CM (ChatItem c 'MDSnd)
saveSndChatItem' User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) SndMessage
msg CIContent 'MDSnd
content Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing Maybe (CIQuote 'CTDirect)
forall a. Maybe a
Nothing Maybe CIForwardedFrom
forall a. Maybe a
Nothing Maybe CITimed
timed_ Bool
False
      ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatEvent
CEvtNewChatItems User
user [SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct) ChatItem 'CTDirect 'MDSnd
ci]
      Maybe UTCTime
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe CITimed
timed_ Maybe CITimed -> (CITimed -> Maybe UTCTime) -> Maybe UTCTime
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CITimed -> Maybe UTCTime
timedDeleteAt') ((UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
        User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing, ChatItem 'CTDirect 'MDSnd -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem 'CTDirect 'MDSnd
ci)
    drgRandomBytes :: Int -> CM ByteString
    drgRandomBytes :: Int -> CM ByteString
drgRandomBytes Int
n = (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
-> (TVar ChaChaDRG -> CM ByteString) -> CM ByteString
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM ByteString -> CM ByteString
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM ByteString -> CM ByteString)
-> (TVar ChaChaDRG -> STM ByteString)
-> TVar ChaChaDRG
-> CM ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TVar ChaChaDRG -> STM ByteString
C.randomBytes Int
n
    privateGetUser :: UserId -> CM User
    privateGetUser :: Int64 -> CM User
privateGetUser Int64
userId =
      CM User
-> ExceptT
     ChatError (ReaderT ChatController IO) (Either ChatError User)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors ((Connection -> ExceptT StoreError IO User) -> CM User
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore (Connection -> Int64 -> ExceptT StoreError IO User
`getUser` Int64
userId)) ExceptT
  ChatError (ReaderT ChatController IO) (Either ChatError User)
-> (Either ChatError User -> CM User) -> CM User
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ChatError
_ -> ChatErrorType -> CM User
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEUserUnknown
        Right User
user -> User -> CM User
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure User
user
    validateUserPassword :: User -> User -> Maybe UserPwd -> CM ()
    validateUserPassword :: User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword = Maybe User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword_ (Maybe User
 -> User
 -> Maybe UserPwd
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (User -> Maybe User)
-> User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Maybe User
forall a. a -> Maybe a
Just
    validateUserPassword_ :: Maybe User -> User -> Maybe UserPwd -> CM ()
    validateUserPassword_ :: Maybe User
-> User
-> Maybe UserPwd
-> ExceptT ChatError (ReaderT ChatController IO) ()
validateUserPassword_ Maybe User
user_ User {userId :: User -> Int64
userId = Int64
userId', Maybe UserPwdHash
viewPwdHash :: User -> Maybe UserPwdHash
viewPwdHash :: Maybe UserPwdHash
viewPwdHash} Maybe UserPwd
viewPwd_ =
      Maybe UserPwdHash
-> (UserPwdHash
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe UserPwdHash
viewPwdHash ((UserPwdHash -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UserPwdHash
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \UserPwdHash
pwdHash ->
        let userId_ :: Maybe Int64
userId_ = (\User {Int64
userId :: User -> Int64
userId :: Int64
userId} -> Int64
userId) (User -> Int64) -> Maybe User -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe User
user_
            pwdOk :: Bool
pwdOk = case Maybe UserPwd
viewPwd_ of
              Maybe UserPwd
Nothing -> Maybe Int64
userId_ Maybe Int64 -> Maybe Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
userId'
              Just (UserPwd Text
viewPwd) -> Text -> UserPwdHash -> Bool
validPassword Text
viewPwd UserPwdHash
pwdHash
         in Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pwdOk (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEUserUnknown
    validPassword :: Text -> UserPwdHash -> Bool
    validPassword :: Text -> UserPwdHash -> Bool
validPassword Text
pwd UserPwdHash {hash :: UserPwdHash -> B64UrlByteString
hash = B64UrlByteString ByteString
hash, salt :: UserPwdHash -> B64UrlByteString
salt = B64UrlByteString ByteString
salt} =
      ByteString
hash ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
C.sha512Hash (Text -> ByteString
encodeUtf8 Text
pwd ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
salt)
    setUserNotifications :: UserId -> Bool -> CM ChatResponse
    setUserNotifications :: Int64 -> Bool -> CM ChatResponse
setUserNotifications Int64
userId' Bool
showNtfs = (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
      User
user' <- Int64 -> CM User
privateGetUser Int64
userId'
      case User -> Maybe UserPwdHash
viewPwdHash User
user' of
        Just UserPwdHash
_ -> ChatErrorType -> CM ChatResponse
forall a. ChatErrorType -> CM a
throwChatError (ChatErrorType -> CM ChatResponse)
-> ChatErrorType -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> ChatErrorType
CEHiddenUserAlwaysMuted Int64
userId'
        Maybe UserPwdHash
_ -> User -> User -> CM ChatResponse
setUserPrivacy User
user User
user' {showNtfs}
    setUserPrivacy :: User -> User -> CM ChatResponse
    setUserPrivacy :: User -> User -> CM ChatResponse
setUserPrivacy user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} user' :: User
user'@User {userId :: User -> Int64
userId = Int64
userId'}
      | Int64
userId Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
userId' = do
          (ChatController -> TVar (Maybe User))
-> ExceptT
     ChatError (ReaderT ChatController IO) (TVar (Maybe User))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar (Maybe User)
currentUser ExceptT ChatError (ReaderT ChatController IO) (TVar (Maybe User))
-> (TVar (Maybe User)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (TVar (Maybe User) -> STM ())
-> TVar (Maybe User)
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar (Maybe User) -> Maybe User -> STM ()
forall a. TVar a -> a -> STM ()
`writeTVar` User -> Maybe User
forall a. a -> Maybe a
Just User
user')
          (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO ()
`updateUserPrivacy` User
user')
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ CRUserPrivacy {user :: User
user = User
user', updatedUser :: User
updatedUser = User
user'}
      | Bool
otherwise = do
          (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO ()
`updateUserPrivacy` User
user')
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ CRUserPrivacy {User
user :: User
user :: User
user, updatedUser :: User
updatedUser = User
user'}
    checkDeleteChatUser :: User -> CM ()
    checkDeleteChatUser :: User -> ExceptT ChatError (ReaderT ChatController IO) ()
checkDeleteChatUser user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} = do
      [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withFastStore' Connection -> IO [User]
getUsers
      let otherVisible :: [User]
otherVisible = (User -> Bool) -> [User] -> [User]
forall a. (a -> Bool) -> [a] -> [a]
filter (\User {userId :: User -> Int64
userId = Int64
userId', Maybe UserPwdHash
viewPwdHash :: User -> Maybe UserPwdHash
viewPwdHash :: Maybe UserPwdHash
viewPwdHash} -> Int64
userId Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
userId' Bool -> Bool -> Bool
&& Maybe UserPwdHash -> Bool
forall a. Maybe a -> Bool
isNothing Maybe UserPwdHash
viewPwdHash) [User]
users
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (User -> Bool
activeUser User
user Bool -> Bool -> Bool
&& [User] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [User]
otherVisible Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (Int64 -> ChatErrorType
CECantDeleteActiveUser Int64
userId)
    deleteChatUser :: User -> Bool -> CM ChatResponse
    deleteChatUser :: User -> Bool -> CM ChatResponse
deleteChatUser User
user Bool
delSMPQueues = do
      [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO [CIFileInfo]
`getUserFileInfo` User
user)
      User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteCIFiles User
user [CIFileInfo]
filesInfo
      (AgentClient -> ExceptT AgentErrorType IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient -> Int64 -> Bool -> ExceptT AgentErrorType IO ()
deleteUser AgentClient
a (User -> Int64
aUserId User
user) Bool
delSMPQueues)
        ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` \case
          e :: ChatError
e@(ChatErrorAgent AgentErrorType
NO_USER AgentConnId
_ Maybe ConnectionEntity
_) -> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView ChatError
e
          ChatError
e -> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
e
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> User -> IO ()
`deleteUserRecord` User
user)
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (User -> Bool
activeUser User
user) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ (ChatController -> TVar (Maybe User))
-> Maybe User -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
(ChatController -> TVar a)
-> a -> ExceptT ChatError (ReaderT ChatController IO) ()
chatWriteVar ChatController -> TVar (Maybe User)
currentUser Maybe User
forall a. Maybe a
Nothing
      CM ChatResponse
ok_
    updateChatSettings :: ChatName -> (ChatSettings -> ChatSettings) -> CM ChatResponse
    updateChatSettings :: ChatName -> (ChatSettings -> ChatSettings) -> CM ChatResponse
updateChatSettings (ChatName ChatType
cType Text
name) ChatSettings -> ChatSettings
updateSettings = (User -> CM ChatResponse) -> CM ChatResponse
withUser ((User -> CM ChatResponse) -> CM ChatResponse)
-> (User -> CM ChatResponse) -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ \User
user -> do
      (Int64
chatId, ChatSettings
chatSettings) <- case ChatType
cType of
        ChatType
CTDirect -> (Connection -> ExceptT StoreError IO (Int64, ChatSettings))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Int64, ChatSettings)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Int64, ChatSettings))
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Int64, ChatSettings))
-> (Connection -> ExceptT StoreError IO (Int64, ChatSettings))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Int64, ChatSettings)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          Int64
ctId <- Connection -> User -> Text -> ExceptT StoreError IO Int64
getContactIdByName Connection
db User
user Text
name
          Contact {ChatSettings
chatSettings :: ChatSettings
chatSettings :: Contact -> ChatSettings
chatSettings} <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
ctId
          (Int64, ChatSettings)
-> ExceptT StoreError IO (Int64, ChatSettings)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
ctId, ChatSettings
chatSettings)
        ChatType
CTGroup ->
          (Connection -> ExceptT StoreError IO (Int64, ChatSettings))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Int64, ChatSettings)
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO (Int64, ChatSettings))
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Int64, ChatSettings))
-> (Connection -> ExceptT StoreError IO (Int64, ChatSettings))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Int64, ChatSettings)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
            Int64
gId <- Connection -> User -> Text -> ExceptT StoreError IO Int64
getGroupIdByName Connection
db User
user Text
name
            GroupInfo {ChatSettings
chatSettings :: GroupInfo -> ChatSettings
chatSettings :: ChatSettings
chatSettings} <- Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId
            (Int64, ChatSettings)
-> ExceptT StoreError IO (Int64, ChatSettings)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64
gId, ChatSettings
chatSettings)
        ChatType
_ -> String
-> ExceptT
     ChatError (ReaderT ChatController IO) (Int64, ChatSettings)
forall a. String -> CM a
throwCmdError String
"not supported"
      VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ ChatRef -> ChatSettings -> ChatCommand
APISetChatSettings (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
forall a. Maybe a
Nothing) (ChatSettings -> ChatCommand) -> ChatSettings -> ChatCommand
forall a b. (a -> b) -> a -> b
$ ChatSettings -> ChatSettings
updateSettings ChatSettings
chatSettings
    connectPlan :: User -> AConnectionLink -> CM (ACreatedConnLink, ConnectionPlan)
    connectPlan :: User
-> AConnectionLink
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
connectPlan User
user (ACL SConnectionMode m
SCMInvitation ConnectionLink m
cLink) = case ConnectionLink m
cLink of
      CLFull ConnectionRequestUri m
cReq -> ConnReqInvitation
-> Maybe ShortLinkInvitation
-> Maybe ContactShortLinkData
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
invitationReqAndPlan ConnectionRequestUri m
ConnReqInvitation
cReq Maybe ShortLinkInvitation
forall a. Maybe a
Nothing Maybe ContactShortLinkData
forall a. Maybe a
Nothing
      CLShort ConnShortLink m
l -> do
        let l' :: ConnShortLink m
l' = ConnShortLink m -> ConnShortLink m
forall (m :: ConnectionMode). ConnShortLink m -> ConnShortLink m
serverShortLink ConnShortLink m
l
        ShortLinkInvitation
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans ConnShortLink m
ShortLinkInvitation
l' CM (Maybe (ACreatedConnLink, ConnectionPlan))
-> (Maybe (ACreatedConnLink, ConnectionPlan)
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (ACreatedConnLink, ConnectionPlan))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just (ACreatedConnLink, ConnectionPlan)
r -> (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACreatedConnLink, ConnectionPlan)
r
          Maybe (ACreatedConnLink, ConnectionPlan)
Nothing -> do
            (ConnectionRequestUri m
cReq, ConnLinkData m
cData) <- User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
forall (m :: ConnectionMode).
User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
getShortLinkConnReq User
user ConnShortLink m
l'
            Maybe ContactShortLinkData
contactSLinkData_ <- IO (Maybe ContactShortLinkData)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ContactShortLinkData)
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContactShortLinkData)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe ContactShortLinkData))
-> IO (Maybe ContactShortLinkData)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ContactShortLinkData)
forall a b. (a -> b) -> a -> b
$ ConnLinkData m -> IO (Maybe ContactShortLinkData)
forall a (c :: ConnectionMode).
FromJSON a =>
ConnLinkData c -> IO (Maybe a)
decodeShortLinkData ConnLinkData m
cData
            ConnReqInvitation
-> Maybe ShortLinkInvitation
-> Maybe ContactShortLinkData
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
invitationReqAndPlan ConnectionRequestUri m
ConnReqInvitation
cReq (ShortLinkInvitation -> Maybe ShortLinkInvitation
forall a. a -> Maybe a
Just ConnShortLink m
ShortLinkInvitation
l') Maybe ContactShortLinkData
contactSLinkData_
      where
        knownLinkPlans :: ShortLinkInvitation
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans ShortLinkInvitation
l' = (Connection
 -> ExceptT
      StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
 -> CM (Maybe (ACreatedConnLink, ConnectionPlan)))
-> (Connection
    -> ExceptT
         StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
          let inv :: ConnReqInvitation -> ACreatedConnLink
inv ConnReqInvitation
cReq = SConnectionMode 'CMInvitation
-> CreatedConnLink 'CMInvitation -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode 'CMInvitation
SCMInvitation (CreatedConnLink 'CMInvitation -> ACreatedConnLink)
-> CreatedConnLink 'CMInvitation -> ACreatedConnLink
forall a b. (a -> b) -> a -> b
$ ConnReqInvitation
-> Maybe ShortLinkInvitation -> CreatedConnLink 'CMInvitation
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqInvitation
cReq (ShortLinkInvitation -> Maybe ShortLinkInvitation
forall a. a -> Maybe a
Just ShortLinkInvitation
l')
          IO (Maybe (ConnReqInvitation, ConnectionEntity))
-> ExceptT
     StoreError IO (Maybe (ConnReqInvitation, ConnectionEntity))
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection
-> VersionRangeChat
-> User
-> ShortLinkInvitation
-> IO (Maybe (ConnReqInvitation, ConnectionEntity))
getConnectionEntityViaShortLink Connection
db VersionRangeChat
vr User
user ShortLinkInvitation
l') ExceptT StoreError IO (Maybe (ConnReqInvitation, ConnectionEntity))
-> (Maybe (ConnReqInvitation, ConnectionEntity)
    -> ExceptT
         StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just (ConnReqInvitation
cReq, ConnectionEntity
ent) -> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ACreatedConnLink, ConnectionPlan)
 -> ExceptT
      StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b. (a -> b) -> a -> b
$ (ACreatedConnLink, ConnectionPlan)
-> Maybe (ACreatedConnLink, ConnectionPlan)
forall a. a -> Maybe a
Just (ConnReqInvitation -> ACreatedConnLink
inv ConnReqInvitation
cReq, Maybe ContactShortLinkData -> ConnectionEntity -> ConnectionPlan
invitationEntityPlan Maybe ContactShortLinkData
forall a. Maybe a
Nothing ConnectionEntity
ent)
            -- deleted contact is returned as known, as invitation link cannot be re-used too connect anyway
            Maybe (ConnReqInvitation, ConnectionEntity)
Nothing -> (ConnReqInvitation -> ACreatedConnLink)
-> (Contact -> ConnectionPlan)
-> (ConnReqInvitation, Contact)
-> (ACreatedConnLink, ConnectionPlan)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ConnReqInvitation -> ACreatedConnLink
inv (InvitationLinkPlan -> ConnectionPlan
CPInvitationLink (InvitationLinkPlan -> ConnectionPlan)
-> (Contact -> InvitationLinkPlan) -> Contact -> ConnectionPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contact -> InvitationLinkPlan
ILPKnown) ((ConnReqInvitation, Contact)
 -> (ACreatedConnLink, ConnectionPlan))
-> ExceptT StoreError IO (Maybe (ConnReqInvitation, Contact))
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Connection
-> VersionRangeChat
-> User
-> ShortLinkInvitation
-> ExceptT StoreError IO (Maybe (ConnReqInvitation, Contact))
forall (c :: ConnectionMode).
ConnectionModeI c =>
Connection
-> VersionRangeChat
-> User
-> ConnShortLink c
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
getContactViaShortLinkToConnect Connection
db VersionRangeChat
vr User
user ShortLinkInvitation
l'
        invitationReqAndPlan :: ConnReqInvitation
-> Maybe ShortLinkInvitation
-> Maybe ContactShortLinkData
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
invitationReqAndPlan ConnReqInvitation
cReq Maybe ShortLinkInvitation
sLnk_ Maybe ContactShortLinkData
contactSLinkData_ = do
          ConnectionPlan
plan <- User
-> ConnReqInvitation
-> Maybe ContactShortLinkData
-> CM ConnectionPlan
invitationRequestPlan User
user ConnReqInvitation
cReq Maybe ContactShortLinkData
contactSLinkData_ CM ConnectionPlan
-> (ChatError -> CM ConnectionPlan) -> CM ConnectionPlan
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` (ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> (ChatError -> ConnectionPlan) -> ChatError -> CM ConnectionPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatError -> ConnectionPlan
CPError)
          (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SConnectionMode 'CMInvitation
-> CreatedConnLink 'CMInvitation -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode 'CMInvitation
SCMInvitation (ConnReqInvitation
-> Maybe ShortLinkInvitation -> CreatedConnLink 'CMInvitation
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqInvitation
cReq Maybe ShortLinkInvitation
sLnk_), ConnectionPlan
plan)
    connectPlan User
user (ACL SConnectionMode m
SCMContact ConnectionLink m
cLink) = case ConnectionLink m
cLink of
      CLFull ConnectionRequestUri m
cReq -> do
        ConnectionPlan
plan <- User -> ConnReqContact -> CM ConnectionPlan
contactOrGroupRequestPlan User
user ConnectionRequestUri m
ConnReqContact
cReq CM ConnectionPlan
-> (ChatError -> CM ConnectionPlan) -> CM ConnectionPlan
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` (ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> (ChatError -> ConnectionPlan) -> ChatError -> CM ConnectionPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatError -> ConnectionPlan
CPError)
        (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SConnectionMode 'CMContact
-> CreatedLinkContact -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode 'CMContact
SCMContact (CreatedLinkContact -> ACreatedConnLink)
-> CreatedLinkContact -> ACreatedConnLink
forall a b. (a -> b) -> a -> b
$ ConnReqContact
-> Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnectionRequestUri m
ConnReqContact
cReq Maybe (ConnShortLink 'CMContact)
forall a. Maybe a
Nothing, ConnectionPlan
plan)
      CLShort l :: ConnShortLink m
l@(CSLContact ShortLinkScheme
_ ContactConnType
ct SMPServer
_ LinkKey
_) -> do
        let l' :: ConnShortLink m
l' = ConnShortLink m -> ConnShortLink m
forall (m :: ConnectionMode). ConnShortLink m -> ConnShortLink m
serverShortLink ConnShortLink m
l
            con :: ConnReqContact -> ACreatedConnLink
con ConnReqContact
cReq = SConnectionMode 'CMContact
-> CreatedLinkContact -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode 'CMContact
SCMContact (CreatedLinkContact -> ACreatedConnLink)
-> CreatedLinkContact -> ACreatedConnLink
forall a b. (a -> b) -> a -> b
$ ConnReqContact
-> Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqContact
cReq (ConnShortLink 'CMContact -> Maybe (ConnShortLink 'CMContact)
forall a. a -> Maybe a
Just ConnShortLink m
ConnShortLink 'CMContact
l')
            gPlan :: (ConnReqContact, GroupInfo)
-> Maybe (ACreatedConnLink, ConnectionPlan)
gPlan (ConnReqContact
cReq, GroupInfo
g) = if GroupMember -> Bool
memberRemoved (GroupInfo -> GroupMember
membership GroupInfo
g) then Maybe (ACreatedConnLink, ConnectionPlan)
forall a. Maybe a
Nothing else (ACreatedConnLink, ConnectionPlan)
-> Maybe (ACreatedConnLink, ConnectionPlan)
forall a. a -> Maybe a
Just (ConnReqContact -> ACreatedConnLink
con ConnReqContact
cReq, GroupLinkPlan -> ConnectionPlan
CPGroupLink (GroupInfo -> GroupLinkPlan
GLPKnown GroupInfo
g))
        case ContactConnType
ct of
          ContactConnType
CCTContact ->
            CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans CM (Maybe (ACreatedConnLink, ConnectionPlan))
-> (Maybe (ACreatedConnLink, ConnectionPlan)
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (ACreatedConnLink, ConnectionPlan))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just (ACreatedConnLink, ConnectionPlan)
r -> (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACreatedConnLink, ConnectionPlan)
r
              Maybe (ACreatedConnLink, ConnectionPlan)
Nothing -> do
                (ConnectionRequestUri m
cReq, ConnLinkData m
cData) <- User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
forall (m :: ConnectionMode).
User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
getShortLinkConnReq User
user ConnShortLink m
l'
                (Connection -> IO (Maybe Contact))
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Contact)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> ConnShortLink 'CMContact
-> IO (Maybe Contact)
getContactWithoutConnViaShortAddress Connection
db VersionRangeChat
vr User
user ConnShortLink m
ConnShortLink 'CMContact
l') ExceptT ChatError (ReaderT ChatController IO) (Maybe Contact)
-> (Maybe Contact
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (ACreatedConnLink, ConnectionPlan))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Just Contact
ct' | Bool -> Bool
not (Contact -> Bool
contactDeleted Contact
ct') -> (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnReqContact -> ACreatedConnLink
con ConnectionRequestUri m
ConnReqContact
cReq, ContactAddressPlan -> ConnectionPlan
CPContactAddress (Contact -> ContactAddressPlan
CAPContactViaAddress Contact
ct'))
                  Maybe Contact
_ -> do
                    Maybe ContactShortLinkData
contactSLinkData_ <- IO (Maybe ContactShortLinkData)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ContactShortLinkData)
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContactShortLinkData)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe ContactShortLinkData))
-> IO (Maybe ContactShortLinkData)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe ContactShortLinkData)
forall a b. (a -> b) -> a -> b
$ ConnLinkData m -> IO (Maybe ContactShortLinkData)
forall a (c :: ConnectionMode).
FromJSON a =>
ConnLinkData c -> IO (Maybe a)
decodeShortLinkData ConnLinkData m
cData
                    ConnectionPlan
plan <- User
-> ConnReqContact
-> Maybe ContactShortLinkData
-> CM ConnectionPlan
contactRequestPlan User
user ConnectionRequestUri m
ConnReqContact
cReq Maybe ContactShortLinkData
contactSLinkData_
                    (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnReqContact -> ACreatedConnLink
con ConnectionRequestUri m
ConnReqContact
cReq, ConnectionPlan
plan)
            where
              knownLinkPlans :: CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans = (Connection
 -> ExceptT
      StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
 -> CM (Maybe (ACreatedConnLink, ConnectionPlan)))
-> (Connection
    -> ExceptT
         StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
                IO (Maybe UserContactLink)
-> ExceptT StoreError IO (Maybe UserContactLink)
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection
-> User -> ConnShortLink 'CMContact -> IO (Maybe UserContactLink)
getUserContactLinkViaShortLink Connection
db User
user ConnShortLink m
ConnShortLink 'CMContact
l') ExceptT StoreError IO (Maybe UserContactLink)
-> (Maybe UserContactLink
    -> ExceptT
         StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Just UserContactLink {connLinkContact :: UserContactLink -> CreatedLinkContact
connLinkContact = CCLink ConnReqContact
cReq Maybe (ConnShortLink 'CMContact)
_} -> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ACreatedConnLink, ConnectionPlan)
 -> ExceptT
      StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b. (a -> b) -> a -> b
$ (ACreatedConnLink, ConnectionPlan)
-> Maybe (ACreatedConnLink, ConnectionPlan)
forall a. a -> Maybe a
Just (ConnReqContact -> ACreatedConnLink
con ConnReqContact
cReq, ContactAddressPlan -> ConnectionPlan
CPContactAddress ContactAddressPlan
CAPOwnLink)
                  Maybe UserContactLink
Nothing ->
                    Connection
-> VersionRangeChat
-> User
-> ConnShortLink m
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri m, Contact))
forall (c :: ConnectionMode).
ConnectionModeI c =>
Connection
-> VersionRangeChat
-> User
-> ConnShortLink c
-> ExceptT StoreError IO (Maybe (ConnectionRequestUri c, Contact))
getContactViaShortLinkToConnect Connection
db VersionRangeChat
vr User
user ConnShortLink m
l' ExceptT StoreError IO (Maybe (ConnectionRequestUri m, Contact))
-> (Maybe (ConnectionRequestUri m, Contact)
    -> ExceptT
         StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                      Just (ConnectionRequestUri m
cReq, Contact
ct') -> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ACreatedConnLink, ConnectionPlan)
 -> ExceptT
      StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b. (a -> b) -> a -> b
$ if Contact -> Bool
contactDeleted Contact
ct' then Maybe (ACreatedConnLink, ConnectionPlan)
forall a. Maybe a
Nothing else (ACreatedConnLink, ConnectionPlan)
-> Maybe (ACreatedConnLink, ConnectionPlan)
forall a. a -> Maybe a
Just (ConnReqContact -> ACreatedConnLink
con ConnectionRequestUri m
ConnReqContact
cReq, ContactAddressPlan -> ConnectionPlan
CPContactAddress (Contact -> ContactAddressPlan
CAPKnown Contact
ct'))
                      Maybe (ConnectionRequestUri m, Contact)
Nothing -> ((ConnReqContact, GroupInfo)
-> Maybe (ACreatedConnLink, ConnectionPlan)
gPlan ((ConnReqContact, GroupInfo)
 -> Maybe (ACreatedConnLink, ConnectionPlan))
-> Maybe (ConnReqContact, GroupInfo)
-> Maybe (ACreatedConnLink, ConnectionPlan)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe (ConnReqContact, GroupInfo)
 -> Maybe (ACreatedConnLink, ConnectionPlan))
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> ConnShortLink 'CMContact
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
getGroupViaShortLinkToConnect Connection
db VersionRangeChat
vr User
user ConnShortLink m
ConnShortLink 'CMContact
l'
          ContactConnType
CCTGroup ->
            CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans CM (Maybe (ACreatedConnLink, ConnectionPlan))
-> (Maybe (ACreatedConnLink, ConnectionPlan)
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (ACreatedConnLink, ConnectionPlan))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Just (ACreatedConnLink, ConnectionPlan)
r -> (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACreatedConnLink, ConnectionPlan)
r
              Maybe (ACreatedConnLink, ConnectionPlan)
Nothing -> do
                (ConnectionRequestUri m
cReq, ConnLinkData m
cData) <- User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
forall (m :: ConnectionMode).
User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
getShortLinkConnReq User
user ConnShortLink m
l'
                Maybe GroupShortLinkData
groupSLinkData_ <- IO (Maybe GroupShortLinkData)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupShortLinkData)
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GroupShortLinkData)
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe GroupShortLinkData))
-> IO (Maybe GroupShortLinkData)
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupShortLinkData)
forall a b. (a -> b) -> a -> b
$ ConnLinkData m -> IO (Maybe GroupShortLinkData)
forall a (c :: ConnectionMode).
FromJSON a =>
ConnLinkData c -> IO (Maybe a)
decodeShortLinkData ConnLinkData m
cData
                ConnectionPlan
plan <- User
-> ConnReqContact -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupJoinRequestPlan User
user ConnectionRequestUri m
ConnReqContact
cReq Maybe GroupShortLinkData
groupSLinkData_
                (ACreatedConnLink, ConnectionPlan)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnReqContact -> ACreatedConnLink
con ConnectionRequestUri m
ConnReqContact
cReq, ConnectionPlan
plan)
            where
              knownLinkPlans :: CM (Maybe (ACreatedConnLink, ConnectionPlan))
knownLinkPlans = (Connection
 -> ExceptT
      StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
 -> CM (Maybe (ACreatedConnLink, ConnectionPlan)))
-> (Connection
    -> ExceptT
         StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> CM (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
                IO (Maybe (ConnReqContact, GroupInfo))
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
forall a. IO a -> ExceptT StoreError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection
-> VersionRangeChat
-> User
-> ConnShortLink 'CMContact
-> IO (Maybe (ConnReqContact, GroupInfo))
getGroupInfoViaUserShortLink Connection
db VersionRangeChat
vr User
user ConnShortLink m
ConnShortLink 'CMContact
l') ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
-> (Maybe (ConnReqContact, GroupInfo)
    -> ExceptT
         StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b.
ExceptT StoreError IO a
-> (a -> ExceptT StoreError IO b) -> ExceptT StoreError IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Just (ConnReqContact
cReq, GroupInfo
g) -> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ACreatedConnLink, ConnectionPlan)
 -> ExceptT
      StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan)))
-> Maybe (ACreatedConnLink, ConnectionPlan)
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall a b. (a -> b) -> a -> b
$ (ACreatedConnLink, ConnectionPlan)
-> Maybe (ACreatedConnLink, ConnectionPlan)
forall a. a -> Maybe a
Just (ConnReqContact -> ACreatedConnLink
con ConnReqContact
cReq, GroupLinkPlan -> ConnectionPlan
CPGroupLink (GroupInfo -> GroupLinkPlan
GLPOwnLink GroupInfo
g))
                  Maybe (ConnReqContact, GroupInfo)
Nothing -> ((ConnReqContact, GroupInfo)
-> Maybe (ACreatedConnLink, ConnectionPlan)
gPlan ((ConnReqContact, GroupInfo)
 -> Maybe (ACreatedConnLink, ConnectionPlan))
-> Maybe (ConnReqContact, GroupInfo)
-> Maybe (ACreatedConnLink, ConnectionPlan)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe (ConnReqContact, GroupInfo)
 -> Maybe (ACreatedConnLink, ConnectionPlan))
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
-> ExceptT StoreError IO (Maybe (ACreatedConnLink, ConnectionPlan))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> VersionRangeChat
-> User
-> ConnShortLink 'CMContact
-> ExceptT StoreError IO (Maybe (ConnReqContact, GroupInfo))
getGroupViaShortLinkToConnect Connection
db VersionRangeChat
vr User
user ConnShortLink m
ConnShortLink 'CMContact
l'
          ContactConnType
CCTChannel -> String
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. String -> CM a
throwCmdError String
"channel links are not supported in this version"
          ContactConnType
CCTRelay -> String
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (ACreatedConnLink, ConnectionPlan)
forall a. String -> CM a
throwCmdError String
"chat relay links are not supported in this version"
    connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
    connectWithPlan :: User
-> Bool -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
connectWithPlan user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Bool
incognito ACreatedConnLink
ccLink ConnectionPlan
plan
      | ConnectionPlan -> Bool
connectionPlanProceed ConnectionPlan
plan = do
          case ConnectionPlan
plan of CPError ChatError
e -> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView ChatError
e; ConnectionPlan
_ -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          case ConnectionPlan
plan of
            CPContactAddress (CAPContactViaAddress Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId}) ->
              VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> Int64 -> ChatCommand
APIConnectContactViaAddress Int64
userId Bool
incognito Int64
contactId
            ConnectionPlan
_ -> VersionRangeChat
-> NetworkRequestMode -> ChatCommand -> CM ChatResponse
processChatCommand VersionRangeChat
vr NetworkRequestMode
nm (ChatCommand -> CM ChatResponse) -> ChatCommand -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> Maybe ACreatedConnLink -> ChatCommand
APIConnect Int64
userId Bool
incognito (Maybe ACreatedConnLink -> ChatCommand)
-> Maybe ACreatedConnLink -> ChatCommand
forall a b. (a -> b) -> a -> b
$ ACreatedConnLink -> Maybe ACreatedConnLink
forall a. a -> Maybe a
Just ACreatedConnLink
ccLink
      | Bool
otherwise = ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> ACreatedConnLink -> ConnectionPlan -> ChatResponse
CRConnectionPlan User
user ACreatedConnLink
ccLink ConnectionPlan
plan
    invitationRequestPlan :: User -> ConnReqInvitation -> Maybe ContactShortLinkData -> CM ConnectionPlan
    invitationRequestPlan :: User
-> ConnReqInvitation
-> Maybe ContactShortLinkData
-> CM ConnectionPlan
invitationRequestPlan User
user ConnReqInvitation
cReq Maybe ContactShortLinkData
contactSLinkData_ = do
      ConnectionPlan
-> (ConnectionEntity -> ConnectionPlan)
-> Maybe ConnectionEntity
-> ConnectionPlan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvitationLinkPlan -> ConnectionPlan
CPInvitationLink (Maybe ContactShortLinkData -> InvitationLinkPlan
ILPOk Maybe ContactShortLinkData
contactSLinkData_)) (Maybe ContactShortLinkData -> ConnectionEntity -> ConnectionPlan
invitationEntityPlan Maybe ContactShortLinkData
contactSLinkData_)
        (Maybe ConnectionEntity -> ConnectionPlan)
-> CM (Maybe ConnectionEntity) -> CM ConnectionPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO (Maybe ConnectionEntity))
-> CM (Maybe ConnectionEntity)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> (ConnReqInvitation, ConnReqInvitation)
-> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq Connection
db VersionRangeChat
vr User
user ((ConnReqInvitation, ConnReqInvitation)
 -> IO (Maybe ConnectionEntity))
-> (ConnReqInvitation, ConnReqInvitation)
-> IO (Maybe ConnectionEntity)
forall a b. (a -> b) -> a -> b
$ ConnReqInvitation -> (ConnReqInvitation, ConnReqInvitation)
invCReqSchemas ConnReqInvitation
cReq)
      where
        invCReqSchemas :: ConnReqInvitation -> (ConnReqInvitation, ConnReqInvitation)
        invCReqSchemas :: ConnReqInvitation -> (ConnReqInvitation, ConnReqInvitation)
invCReqSchemas (CRInvitationUri ConnReqUriData
crData RcvE2ERatchetParamsUri 'X448
e2e) =
          ( ConnReqUriData -> RcvE2ERatchetParamsUri 'X448 -> ConnReqInvitation
CRInvitationUri ConnReqUriData
crData {crScheme = SSSimplex} RcvE2ERatchetParamsUri 'X448
e2e,
            ConnReqUriData -> RcvE2ERatchetParamsUri 'X448 -> ConnReqInvitation
CRInvitationUri ConnReqUriData
crData {crScheme = simplexChat} RcvE2ERatchetParamsUri 'X448
e2e
          )
    invitationEntityPlan :: Maybe ContactShortLinkData -> ConnectionEntity -> ConnectionPlan
    invitationEntityPlan :: Maybe ContactShortLinkData -> ConnectionEntity -> ConnectionPlan
invitationEntityPlan Maybe ContactShortLinkData
contactSLinkData_ = \case
      RcvDirectMsgConnection Connection {ConnStatus
connStatus :: Connection -> ConnStatus
connStatus :: ConnStatus
connStatus, Bool
contactConnInitiated :: Connection -> Bool
contactConnInitiated :: Bool
contactConnInitiated} Maybe Contact
ct_ -> case Maybe Contact
ct_ of
        Just Contact
ct
          | Contact -> Bool
contactActive Contact
ct -> InvitationLinkPlan -> ConnectionPlan
CPInvitationLink (Contact -> InvitationLinkPlan
ILPKnown Contact
ct)
          | Bool
otherwise -> InvitationLinkPlan -> ConnectionPlan
CPInvitationLink (Maybe ContactShortLinkData -> InvitationLinkPlan
ILPOk Maybe ContactShortLinkData
contactSLinkData_)
        Maybe Contact
Nothing
          | ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnNew Bool -> Bool -> Bool
&& Bool
contactConnInitiated -> InvitationLinkPlan -> ConnectionPlan
CPInvitationLink InvitationLinkPlan
ILPOwnLink
          | ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnPrepared -> InvitationLinkPlan -> ConnectionPlan
CPInvitationLink (Maybe ContactShortLinkData -> InvitationLinkPlan
ILPOk Maybe ContactShortLinkData
contactSLinkData_)
          | Bool
otherwise -> InvitationLinkPlan -> ConnectionPlan
CPInvitationLink (Maybe Contact -> InvitationLinkPlan
ILPConnecting Maybe Contact
forall a. Maybe a
Nothing)
      ConnectionEntity
_ -> ChatError -> ConnectionPlan
CPError (ChatError -> ConnectionPlan) -> ChatError -> ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ChatErrorType -> ChatError
ChatError (ChatErrorType -> ChatError) -> ChatErrorType -> ChatError
forall a b. (a -> b) -> a -> b
$ String -> ChatErrorType
CECommandError String
"found connection entity is not RcvDirectMsgConnection"
    contactOrGroupRequestPlan ::  User -> ConnReqContact -> CM ConnectionPlan
    contactOrGroupRequestPlan :: User -> ConnReqContact -> CM ConnectionPlan
contactOrGroupRequestPlan User
user cReq :: ConnReqContact
cReq@(CRContactUri ConnReqUriData
crData) = do
      let ConnReqUriData {Maybe Text
crClientData :: ConnReqUriData -> Maybe Text
crClientData :: Maybe Text
crClientData} = ConnReqUriData
crData
          groupLinkId :: Maybe GroupLinkId
groupLinkId = Maybe Text
crClientData Maybe Text
-> (Text -> Maybe CReqClientData) -> Maybe CReqClientData
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe CReqClientData
forall a. FromJSON a => Text -> Maybe a
decodeJSON Maybe CReqClientData
-> (CReqClientData -> Maybe GroupLinkId) -> Maybe GroupLinkId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(CRDataGroup GroupLinkId
gli) -> GroupLinkId -> Maybe GroupLinkId
forall a. a -> Maybe a
Just GroupLinkId
gli
      case Maybe GroupLinkId
groupLinkId of
        Maybe GroupLinkId
Nothing -> User
-> ConnReqContact
-> Maybe ContactShortLinkData
-> CM ConnectionPlan
contactRequestPlan User
user ConnReqContact
cReq Maybe ContactShortLinkData
forall a. Maybe a
Nothing
        Just GroupLinkId
_ -> User
-> ConnReqContact -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupJoinRequestPlan User
user ConnReqContact
cReq Maybe GroupShortLinkData
forall a. Maybe a
Nothing
    contactRequestPlan :: User -> ConnReqContact -> Maybe ContactShortLinkData -> CM ConnectionPlan
    contactRequestPlan :: User
-> ConnReqContact
-> Maybe ContactShortLinkData
-> CM ConnectionPlan
contactRequestPlan User
user (CRContactUri ConnReqUriData
crData) Maybe ContactShortLinkData
contactSLinkData_ = do
      let cReqSchemas :: (ConnReqContact, ConnReqContact)
cReqSchemas = ConnReqUriData -> (ConnReqContact, ConnReqContact)
contactCReqSchemas ConnReqUriData
crData
          cReqHashes :: (ConnReqUriHash, ConnReqUriHash)
cReqHashes = (ConnReqContact -> ConnReqUriHash)
-> (ConnReqContact -> ConnReqUriHash)
-> (ConnReqContact, ConnReqContact)
-> (ConnReqUriHash, ConnReqUriHash)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ConnReqContact -> ConnReqUriHash
contactCReqHash ConnReqContact -> ConnReqUriHash
contactCReqHash (ConnReqContact, ConnReqContact)
cReqSchemas
      (Connection -> IO (Maybe UserContactLink))
-> CM (Maybe UserContactLink)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> User
-> (ConnReqContact, ConnReqContact)
-> IO (Maybe UserContactLink)
getUserContactLinkByConnReq Connection
db User
user (ConnReqContact, ConnReqContact)
cReqSchemas) CM (Maybe UserContactLink)
-> (Maybe UserContactLink -> CM ConnectionPlan)
-> CM ConnectionPlan
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just UserContactLink
_ -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress ContactAddressPlan
CAPOwnLink
        Maybe UserContactLink
Nothing ->
          (Connection -> IO (Maybe ConnectionEntity))
-> CM (Maybe ConnectionEntity)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> (ConnReqUriHash, ConnReqUriHash)
-> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash Connection
db VersionRangeChat
vr User
user (ConnReqUriHash, ConnReqUriHash)
cReqHashes) CM (Maybe ConnectionEntity)
-> (Maybe ConnectionEntity -> CM ConnectionPlan)
-> CM ConnectionPlan
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe ConnectionEntity
Nothing ->
              (Connection -> IO (Maybe Contact))
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Contact)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> (ConnReqContact, ConnReqContact)
-> IO (Maybe Contact)
getContactWithoutConnViaAddress Connection
db VersionRangeChat
vr User
user (ConnReqContact, ConnReqContact)
cReqSchemas) ExceptT ChatError (ReaderT ChatController IO) (Maybe Contact)
-> (Maybe Contact -> CM ConnectionPlan) -> CM ConnectionPlan
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Contact
ct | Bool -> Bool
not (Contact -> Bool
contactDeleted Contact
ct) -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress (Contact -> ContactAddressPlan
CAPContactViaAddress Contact
ct)
                Maybe Contact
_ -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress (Maybe ContactShortLinkData -> ContactAddressPlan
CAPOk Maybe ContactShortLinkData
contactSLinkData_)
            Just (RcvDirectMsgConnection Connection {ConnStatus
connStatus :: Connection -> ConnStatus
connStatus :: ConnStatus
connStatus} Maybe Contact
Nothing)
              | ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnPrepared -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress (Maybe ContactShortLinkData -> ContactAddressPlan
CAPOk Maybe ContactShortLinkData
contactSLinkData_)
              | Bool
otherwise -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress ContactAddressPlan
CAPConnectingConfirmReconnect
            Just (RcvDirectMsgConnection Connection
_ (Just Contact
ct))
              | Bool -> Bool
not (Contact -> Bool
contactReady Contact
ct) Bool -> Bool -> Bool
&& Contact -> Bool
contactActive Contact
ct -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress (Contact -> ContactAddressPlan
CAPConnectingProhibit Contact
ct)
              | Contact -> Bool
contactDeleted Contact
ct -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress (Maybe ContactShortLinkData -> ContactAddressPlan
CAPOk Maybe ContactShortLinkData
contactSLinkData_)
              | Bool
otherwise -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ ContactAddressPlan -> ConnectionPlan
CPContactAddress (Contact -> ContactAddressPlan
CAPKnown Contact
ct)
            -- TODO [short links] RcvGroupMsgConnection branch is deprecated? (old group link protocol?)
            Just (RcvGroupMsgConnection Connection
_ GroupInfo
gInfo GroupMember
_) -> GroupInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupPlan GroupInfo
gInfo Maybe GroupShortLinkData
forall a. Maybe a
Nothing
            Just ConnectionEntity
_ -> String -> CM ConnectionPlan
forall a. String -> CM a
throwCmdError String
"found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection"
    groupJoinRequestPlan :: User -> ConnReqContact -> Maybe GroupShortLinkData -> CM ConnectionPlan
    groupJoinRequestPlan :: User
-> ConnReqContact -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupJoinRequestPlan User
user (CRContactUri ConnReqUriData
crData) Maybe GroupShortLinkData
groupSLinkData_ = do
      let cReqSchemas :: (ConnReqContact, ConnReqContact)
cReqSchemas = ConnReqUriData -> (ConnReqContact, ConnReqContact)
contactCReqSchemas ConnReqUriData
crData
          cReqHashes :: (ConnReqUriHash, ConnReqUriHash)
cReqHashes = (ConnReqContact -> ConnReqUriHash)
-> (ConnReqContact -> ConnReqUriHash)
-> (ConnReqContact, ConnReqContact)
-> (ConnReqUriHash, ConnReqUriHash)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ConnReqContact -> ConnReqUriHash
contactCReqHash ConnReqContact -> ConnReqUriHash
contactCReqHash (ConnReqContact, ConnReqContact)
cReqSchemas
      (Connection -> IO (Maybe GroupInfo)) -> CM (Maybe GroupInfo)
forall a. (Connection -> IO a) -> CM a
withFastStore' (\Connection
db -> Connection
-> VersionRangeChat
-> User
-> (ConnReqContact, ConnReqContact)
-> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq Connection
db VersionRangeChat
vr User
user (ConnReqContact, ConnReqContact)
cReqSchemas) CM (Maybe GroupInfo)
-> (Maybe GroupInfo -> CM ConnectionPlan) -> CM ConnectionPlan
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just GroupInfo
g -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (GroupInfo -> GroupLinkPlan
GLPOwnLink GroupInfo
g)
        Maybe GroupInfo
Nothing -> do
          Maybe ConnectionEntity
connEnt_ <- (Connection -> IO (Maybe ConnectionEntity))
-> CM (Maybe ConnectionEntity)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (Maybe ConnectionEntity))
 -> CM (Maybe ConnectionEntity))
-> (Connection -> IO (Maybe ConnectionEntity))
-> CM (Maybe ConnectionEntity)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> (ConnReqUriHash, ConnReqUriHash)
-> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash Connection
db VersionRangeChat
vr User
user (ConnReqUriHash, ConnReqUriHash)
cReqHashes
          Maybe GroupInfo
gInfo_ <- (Connection -> IO (Maybe GroupInfo)) -> CM (Maybe GroupInfo)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (Maybe GroupInfo)) -> CM (Maybe GroupInfo))
-> (Connection -> IO (Maybe GroupInfo)) -> CM (Maybe GroupInfo)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> (ConnReqUriHash, ConnReqUriHash)
-> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash Connection
db VersionRangeChat
vr User
user (ConnReqUriHash, ConnReqUriHash)
cReqHashes
          case (Maybe GroupInfo
gInfo_, Maybe ConnectionEntity
connEnt_) of
            (Maybe GroupInfo
Nothing, Maybe ConnectionEntity
Nothing) -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (Maybe GroupShortLinkData -> GroupLinkPlan
GLPOk Maybe GroupShortLinkData
groupSLinkData_)
            -- TODO [short links] RcvDirectMsgConnection branches are deprecated? (old group link protocol?)
            (Maybe GroupInfo
Nothing, Just (RcvDirectMsgConnection Connection
_conn Maybe Contact
Nothing)) -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink GroupLinkPlan
GLPConnectingConfirmReconnect
            (Maybe GroupInfo
Nothing, Just (RcvDirectMsgConnection Connection
_ (Just Contact
ct)))
              | Bool -> Bool
not (Contact -> Bool
contactReady Contact
ct) Bool -> Bool -> Bool
&& Contact -> Bool
contactActive Contact
ct -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (Maybe GroupInfo -> GroupLinkPlan
GLPConnectingProhibit Maybe GroupInfo
gInfo_)
              | Bool
otherwise -> ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (Maybe GroupShortLinkData -> GroupLinkPlan
GLPOk Maybe GroupShortLinkData
groupSLinkData_)
            (Maybe GroupInfo
Nothing, Just ConnectionEntity
_) -> String -> CM ConnectionPlan
forall a. String -> CM a
throwCmdError String
"found connection entity is not RcvDirectMsgConnection"
            (Just GroupInfo
gInfo, Maybe ConnectionEntity
_) -> GroupInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupPlan GroupInfo
gInfo Maybe GroupShortLinkData
groupSLinkData_
    groupPlan :: GroupInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan
    groupPlan :: GroupInfo -> Maybe GroupShortLinkData -> CM ConnectionPlan
groupPlan gInfo :: GroupInfo
gInfo@GroupInfo {GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} Maybe GroupShortLinkData
groupSLinkData_
      | GroupMember -> GroupMemberStatus
memberStatus GroupMember
membership GroupMemberStatus -> GroupMemberStatus -> Bool
forall a. Eq a => a -> a -> Bool
== GroupMemberStatus
GSMemRejected = ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (GroupInfo -> GroupLinkPlan
GLPKnown GroupInfo
gInfo)
      | Bool -> Bool
not (GroupMember -> Bool
memberActive GroupMember
membership) Bool -> Bool -> Bool
&& Bool -> Bool
not (GroupMember -> Bool
memberRemoved GroupMember
membership) =
          ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (Maybe GroupInfo -> GroupLinkPlan
GLPConnectingProhibit (Maybe GroupInfo -> GroupLinkPlan)
-> Maybe GroupInfo -> GroupLinkPlan
forall a b. (a -> b) -> a -> b
$ GroupInfo -> Maybe GroupInfo
forall a. a -> Maybe a
Just GroupInfo
gInfo)
      | GroupMember -> Bool
memberActive GroupMember
membership = ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (GroupInfo -> GroupLinkPlan
GLPKnown GroupInfo
gInfo)
      | Bool
otherwise = ConnectionPlan -> CM ConnectionPlan
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionPlan -> CM ConnectionPlan)
-> ConnectionPlan -> CM ConnectionPlan
forall a b. (a -> b) -> a -> b
$ GroupLinkPlan -> ConnectionPlan
CPGroupLink (Maybe GroupShortLinkData -> GroupLinkPlan
GLPOk Maybe GroupShortLinkData
groupSLinkData_)
    contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
    contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
contactCReqSchemas ConnReqUriData
crData =
      ( ConnReqUriData -> ConnReqContact
CRContactUri ConnReqUriData
crData {crScheme = SSSimplex},
        ConnReqUriData -> ConnReqContact
CRContactUri ConnReqUriData
crData {crScheme = simplexChat}
      )
    contactCReqHash :: ConnReqContact -> ConnReqUriHash
    contactCReqHash :: ConnReqContact -> ConnReqUriHash
contactCReqHash = ByteString -> ConnReqUriHash
ConnReqUriHash (ByteString -> ConnReqUriHash)
-> (ConnReqContact -> ByteString)
-> ConnReqContact
-> ConnReqUriHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
C.sha256Hash (ByteString -> ByteString)
-> (ConnReqContact -> ByteString) -> ConnReqContact -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnReqContact -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode
    getShortLinkConnReq :: User -> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
    getShortLinkConnReq :: forall (m :: ConnectionMode).
User
-> ConnShortLink m -> CM (ConnectionRequestUri m, ConnLinkData m)
getShortLinkConnReq User
user ConnShortLink m
l = do
      ConnShortLink m
l' <- ConnShortLink m
-> ExceptT ChatError (ReaderT ChatController IO) (ConnShortLink m)
forall {f :: * -> *} {m :: ConnectionMode}.
MonadReader ChatController f =>
ConnShortLink m -> f (ConnShortLink m)
restoreShortLink' ConnShortLink m
l
      (ConnectionRequestUri m
cReq, ConnLinkData m
cData) <- (AgentClient
 -> ExceptT
      AgentErrorType IO (ConnectionRequestUri m, ConnLinkData m))
-> CM (ConnectionRequestUri m, ConnLinkData m)
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent ((AgentClient
  -> ExceptT
       AgentErrorType IO (ConnectionRequestUri m, ConnLinkData m))
 -> CM (ConnectionRequestUri m, ConnLinkData m))
-> (AgentClient
    -> ExceptT
         AgentErrorType IO (ConnectionRequestUri m, ConnLinkData m))
-> CM (ConnectionRequestUri m, ConnLinkData m)
forall a b. (a -> b) -> a -> b
$ \AgentClient
a -> AgentClient
-> NetworkRequestMode
-> Int64
-> ConnShortLink m
-> ExceptT
     AgentErrorType IO (ConnectionRequestUri m, ConnLinkData m)
forall (c :: ConnectionMode).
AgentClient
-> NetworkRequestMode
-> Int64
-> ConnShortLink c
-> AE (ConnectionRequestUri c, ConnLinkData c)
getConnShortLink AgentClient
a NetworkRequestMode
nm (User -> Int64
aUserId User
user) ConnShortLink m
l'
      case ConnLinkData m
cData of
        ContactLinkData VersionRangeSMPA
_ UserContactData {Bool
direct :: UserContactData -> Bool
direct :: Bool
direct} | Bool -> Bool
not Bool
direct -> ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEUnsupportedConnReq
        ConnLinkData m
_ -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (ConnectionRequestUri m, ConnLinkData m)
-> CM (ConnectionRequestUri m, ConnLinkData m)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionRequestUri m
cReq, ConnLinkData m
cData)
    -- This function is needed, as UI uses simplex:/ schema in message view, so that the links can be handled without browser,
    -- and short links are stored with server hostname schema, so they wouldn't match without it.
    serverShortLink :: ConnShortLink m -> ConnShortLink m
    serverShortLink :: forall (m :: ConnectionMode). ConnShortLink m -> ConnShortLink m
serverShortLink = \case
      CSLInvitation ShortLinkScheme
_ SMPServer
srv LinkId
lnkId LinkKey
linkKey -> ShortLinkScheme
-> SMPServer -> LinkId -> LinkKey -> ShortLinkInvitation
CSLInvitation ShortLinkScheme
SLSServer SMPServer
srv LinkId
lnkId LinkKey
linkKey
      CSLContact ShortLinkScheme
_ ContactConnType
ct SMPServer
srv LinkKey
linkKey -> ShortLinkScheme
-> ContactConnType
-> SMPServer
-> LinkKey
-> ConnShortLink 'CMContact
CSLContact ShortLinkScheme
SLSServer ContactConnType
ct SMPServer
srv LinkKey
linkKey
    restoreShortLink' :: ConnShortLink m -> f (ConnShortLink m)
restoreShortLink' ConnShortLink m
l = (NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
forall (m :: ConnectionMode).
NonEmpty SMPServer -> ConnShortLink m -> ConnShortLink m
`restoreShortLink` ConnShortLink m
l) (NonEmpty SMPServer -> ConnShortLink m)
-> f (NonEmpty SMPServer) -> f (ConnShortLink m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ChatController -> NonEmpty SMPServer) -> f (NonEmpty SMPServer)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ChatConfig -> NonEmpty SMPServer
shortLinkPresetServers (ChatConfig -> NonEmpty SMPServer)
-> (ChatController -> ChatConfig)
-> ChatController
-> NonEmpty SMPServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> ChatConfig
config)
    contactShortLinkData :: Profile -> Maybe AddressSettings -> UserLinkData
    contactShortLinkData :: Profile -> Maybe AddressSettings -> UserLinkData
contactShortLinkData Profile
p Maybe AddressSettings
settings =
      let msg :: Maybe MsgContent
msg = AddressSettings -> Maybe MsgContent
autoReply (AddressSettings -> Maybe MsgContent)
-> Maybe AddressSettings -> Maybe MsgContent
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe AddressSettings
settings
          business :: Bool
business = Bool -> (AddressSettings -> Bool) -> Maybe AddressSettings -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False AddressSettings -> Bool
businessAddress Maybe AddressSettings
settings
          contactData :: ContactShortLinkData
contactData = Profile -> Maybe MsgContent -> Bool -> ContactShortLinkData
ContactShortLinkData Profile
p Maybe MsgContent
msg Bool
business
       in ContactShortLinkData -> UserLinkData
forall a. ToJSON a => a -> UserLinkData
encodeShortLinkData ContactShortLinkData
contactData
    updatePCCShortLinkData :: PendingContactConnection -> Profile -> CM (Maybe ShortLinkInvitation)
    updatePCCShortLinkData :: PendingContactConnection
-> Profile -> CM (Maybe ShortLinkInvitation)
updatePCCShortLinkData conn :: PendingContactConnection
conn@PendingContactConnection {Maybe (CreatedConnLink 'CMInvitation)
connLinkInv :: PendingContactConnection -> Maybe (CreatedConnLink 'CMInvitation)
connLinkInv :: Maybe (CreatedConnLink 'CMInvitation)
connLinkInv} Profile
profile =
      Maybe ShortLinkInvitation
-> (ShortLinkInvitation
    -> ExceptT
         ChatError (ReaderT ChatController IO) ShortLinkInvitation)
-> CM (Maybe ShortLinkInvitation)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (CreatedConnLink 'CMInvitation -> Maybe ShortLinkInvitation
forall (m :: ConnectionMode).
CreatedConnLink m -> Maybe (ConnShortLink m)
connShortLink (CreatedConnLink 'CMInvitation -> Maybe ShortLinkInvitation)
-> Maybe (CreatedConnLink 'CMInvitation)
-> Maybe ShortLinkInvitation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (CreatedConnLink 'CMInvitation)
connLinkInv) ((ShortLinkInvitation
  -> ExceptT
       ChatError (ReaderT ChatController IO) ShortLinkInvitation)
 -> CM (Maybe ShortLinkInvitation))
-> (ShortLinkInvitation
    -> ExceptT
         ChatError (ReaderT ChatController IO) ShortLinkInvitation)
-> CM (Maybe ShortLinkInvitation)
forall a b. (a -> b) -> a -> b
$ \ShortLinkInvitation
_ -> do
        let userData :: UserLinkData
userData = Profile -> Maybe AddressSettings -> UserLinkData
contactShortLinkData Profile
profile Maybe AddressSettings
forall a. Maybe a
Nothing
            userLinkData :: UserConnLinkData 'CMInvitation
userLinkData = UserLinkData -> UserConnLinkData 'CMInvitation
UserInvLinkData UserLinkData
userData
        ShortLinkInvitation
-> ExceptT
     ChatError (ReaderT ChatController IO) ShortLinkInvitation
forall (m :: ConnectionMode).
ConnShortLink m -> CM (ConnShortLink m)
shortenShortLink' (ShortLinkInvitation
 -> ExceptT
      ChatError (ReaderT ChatController IO) ShortLinkInvitation)
-> ExceptT
     ChatError (ReaderT ChatController IO) ShortLinkInvitation
-> ExceptT
     ChatError (ReaderT ChatController IO) ShortLinkInvitation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (AgentClient -> ExceptT AgentErrorType IO ShortLinkInvitation)
-> ExceptT
     ChatError (ReaderT ChatController IO) ShortLinkInvitation
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> NetworkRequestMode
-> ByteString
-> SConnectionMode 'CMInvitation
-> UserConnLinkData 'CMInvitation
-> Maybe Text
-> ExceptT AgentErrorType IO ShortLinkInvitation
forall (c :: ConnectionMode).
AgentClient
-> NetworkRequestMode
-> ByteString
-> SConnectionMode c
-> UserConnLinkData c
-> Maybe Text
-> AE (ConnShortLink c)
setConnShortLink AgentClient
a NetworkRequestMode
nm (PendingContactConnection -> ByteString
aConnId' PendingContactConnection
conn) SConnectionMode 'CMInvitation
SCMInvitation UserConnLinkData 'CMInvitation
userLinkData Maybe Text
forall a. Maybe a
Nothing)
    updateCIGroupInvitationStatus :: User -> GroupInfo -> CIGroupInvitationStatus -> CM ()
    updateCIGroupInvitationStatus :: User
-> GroupInfo
-> CIGroupInvitationStatus
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateCIGroupInvitationStatus User
user GroupInfo {Int64
groupId :: GroupInfo -> Int64
groupId :: Int64
groupId} CIGroupInvitationStatus
newStatus = do
      AChatItem SChatType c
_ SMsgDirection d
_ ChatInfo c
cInfo ChatItem {CIContent d
content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content :: CIContent d
content, meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {Int64
itemId :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> Int64
itemId :: Int64
itemId}} <- (Connection -> ExceptT StoreError IO AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO AChatItem)
 -> ExceptT ChatError (ReaderT ChatController IO) AChatItem)
-> (Connection -> ExceptT StoreError IO AChatItem)
-> ExceptT ChatError (ReaderT ChatController IO) AChatItem
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO AChatItem
getChatItemByGroupId Connection
db VersionRangeChat
vr User
user Int64
groupId
      case (ChatInfo c
cInfo, CIContent d
content) of
        (DirectChat ct :: Contact
ct@Contact {Int64
contactId :: Contact -> Int64
contactId :: Int64
contactId}, CIRcvGroupInvitation ciGroupInv :: CIGroupInvitation
ciGroupInv@CIGroupInvitation {CIGroupInvitationStatus
status :: CIGroupInvitation -> CIGroupInvitationStatus
status :: CIGroupInvitationStatus
status} GroupMemberRole
memRole)
          | CIGroupInvitationStatus
status CIGroupInvitationStatus -> CIGroupInvitationStatus -> Bool
forall a. Eq a => a -> a -> Bool
== CIGroupInvitationStatus
CIGISPending -> do
              let aciContent :: ACIContent
aciContent = SMsgDirection 'MDRcv -> CIContent 'MDRcv -> ACIContent
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> CIContent d -> ACIContent
ACIContent SMsgDirection 'MDRcv
SMDRcv (CIContent 'MDRcv -> ACIContent) -> CIContent 'MDRcv -> ACIContent
forall a b. (a -> b) -> a -> b
$ CIGroupInvitation -> GroupMemberRole -> CIContent 'MDRcv
CIRcvGroupInvitation (CIGroupInvitation
ciGroupInv {status = newStatus} :: CIGroupInvitation) GroupMemberRole
memRole
              Maybe CITimed
timed_ <- Contact -> CM (Maybe CITimed)
contactCITimed Contact
ct
              User
-> Contact
-> Int64
-> ACIContent
-> Bool
-> Bool
-> Maybe CITimed
-> Maybe Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
updateDirectChatItemView User
user Contact
ct Int64
itemId ACIContent
aciContent Bool
False Bool
False Maybe CITimed
timed_ Maybe Int64
forall a. Maybe a
Nothing
              Maybe UTCTime
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe CITimed
timed_ Maybe CITimed -> (CITimed -> Maybe UTCTime) -> Maybe UTCTime
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CITimed -> Maybe UTCTime
timedDeleteAt') ((UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
                User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing, Int64
itemId)
        (ChatInfo c, CIContent d)
_ -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- prohibited
    assertAllowedContent :: MsgContent -> CM ()
    assertAllowedContent :: MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ()
assertAllowedContent = \case
      MCReport {} -> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"sending reports via this API is not supported"
      MsgContent
_ -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    assertAllowedContent' :: ComposedMessage -> CM ()
    assertAllowedContent' :: ComposedMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
assertAllowedContent' ComposedMessage {MsgContent
msgContent :: ComposedMessage -> MsgContent
msgContent :: MsgContent
msgContent} = MsgContent -> ExceptT ChatError (ReaderT ChatController IO) ()
assertAllowedContent MsgContent
msgContent
    assertNoMentions :: ComposedMessage -> CM ()
    assertNoMentions :: ComposedMessage -> ExceptT ChatError (ReaderT ChatController IO) ()
assertNoMentions ComposedMessage {Map Text Int64
mentions :: ComposedMessage -> Map Text Int64
mentions :: Map Text Int64
mentions}
      | Map Text Int64 -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Int64
mentions = () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"mentions are not supported in this chat"
    sendContactContentMessages :: User -> ContactId -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
    sendContactContentMessages :: User
-> Int64
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendContactContentMessages User
user Int64
contactId Bool
live Maybe Int
itemTTL NonEmpty ComposedMessageReq
cmrs = do
      Bool
-> NonEmpty ComposedMessageReq
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertMultiSendable Bool
live NonEmpty ComposedMessageReq
cmrs
      Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
contactId
      User
-> MsgDirection
-> Contact
-> CMEventTag 'Json
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (e :: MsgEncoding).
User
-> MsgDirection
-> Contact
-> CMEventTag e
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDirectAllowed User
user MsgDirection
MDSnd Contact
ct CMEventTag 'Json
XMsgNew_
      Contact -> ExceptT ChatError (ReaderT ChatController IO) ()
assertVoiceAllowed Contact
ct
      Contact -> CM ChatResponse
processComposedMessages Contact
ct
      where
        assertVoiceAllowed :: Contact -> CM ()
        assertVoiceAllowed :: Contact -> ExceptT ChatError (ReaderT ChatController IO) ()
assertVoiceAllowed Contact
ct =
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (SChatFeature 'CFVoice -> (PrefEnabled -> Bool) -> Contact -> Bool
forall (f :: ChatFeature).
SChatFeature f -> (PrefEnabled -> Bool) -> Contact -> Bool
featureAllowed SChatFeature 'CFVoice
SCFVoice PrefEnabled -> Bool
forUser Contact
ct) Bool -> Bool -> Bool
&& (ComposedMessageReq -> Bool) -> NonEmpty ComposedMessageReq -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ComposedMessage {MsgContent
msgContent :: ComposedMessage -> MsgContent
msgContent :: MsgContent
msgContent}, Maybe CIForwardedFrom
_, (Text, Maybe MarkdownList)
_, Map Text CIMention
_) -> MsgContent -> Bool
isVoice MsgContent
msgContent) NonEmpty ComposedMessageReq
cmrs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
            String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String
"feature not allowed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ChatFeature -> Text
chatFeatureNameText ChatFeature
CFVoice)
        processComposedMessages :: Contact -> CM ChatResponse
        processComposedMessages :: Contact -> CM ChatResponse
processComposedMessages Contact
ct = do
          (NonEmpty (Maybe FileInvitation)
fInvs_, NonEmpty (Maybe (CIFile 'MDSnd))
ciFiles_) <- NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
-> (NonEmpty (Maybe FileInvitation),
    NonEmpty (Maybe (CIFile 'MDSnd)))
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
L.unzip (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
 -> (NonEmpty (Maybe FileInvitation),
     NonEmpty (Maybe (CIFile 'MDSnd))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation), NonEmpty (Maybe (CIFile 'MDSnd)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  ChatError
  (ReaderT ChatController IO)
  (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
setupSndFileTransfers
          Maybe CITimed
timed_ <- Bool -> Contact -> Maybe Int -> CM (Maybe CITimed)
sndContactCITimed Bool
live Contact
ct Maybe Int
itemTTL
          (NonEmpty MsgContainer
msgContainers, NonEmpty (Maybe (CIQuote 'CTDirect))
quotedItems_) <- NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))
-> (NonEmpty MsgContainer, NonEmpty (Maybe (CIQuote 'CTDirect)))
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
L.unzip (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))
 -> (NonEmpty MsgContainer, NonEmpty (Maybe (CIQuote 'CTDirect))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty MsgContainer, NonEmpty (Maybe (CIQuote 'CTDirect)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ComposedMessageReq, Maybe FileInvitation)
-> Maybe CITimed
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
prepareMsgs (NonEmpty ComposedMessageReq
-> NonEmpty (Maybe FileInvitation)
-> NonEmpty (ComposedMessageReq, Maybe FileInvitation)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
L.zip NonEmpty ComposedMessageReq
cmrs NonEmpty (Maybe FileInvitation)
fInvs_) Maybe CITimed
timed_
          [Either ChatError SndMessage]
msgs_ <- User
-> Contact
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either ChatError SndMessage]
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> Contact
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either ChatError SndMessage]
sendDirectContactMessages User
user Contact
ct (NonEmpty (ChatMsgEvent 'Json)
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      [Either ChatError SndMessage])
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError (ReaderT ChatController IO) [Either ChatError SndMessage]
forall a b. (a -> b) -> a -> b
$ (MsgContainer -> ChatMsgEvent 'Json)
-> NonEmpty MsgContainer -> NonEmpty (ChatMsgEvent 'Json)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
L.map MsgContainer -> ChatMsgEvent 'Json
XMsgNew NonEmpty MsgContainer
msgContainers
          let itemsData :: [Either ChatError (NewSndChatItemData 'CTDirect)]
itemsData = [ComposedMessageReq]
-> [Maybe (CIFile 'MDSnd)]
-> [Maybe (CIQuote 'CTDirect)]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData 'CTDirect)]
forall (c :: ChatType).
[ComposedMessageReq]
-> [Maybe (CIFile 'MDSnd)]
-> [Maybe (CIQuote c)]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData c)]
prepareSndItemsData (NonEmpty ComposedMessageReq -> [ComposedMessageReq]
forall a. NonEmpty a -> [a]
L.toList NonEmpty ComposedMessageReq
cmrs) (NonEmpty (Maybe (CIFile 'MDSnd)) -> [Maybe (CIFile 'MDSnd)]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Maybe (CIFile 'MDSnd))
ciFiles_) (NonEmpty (Maybe (CIQuote 'CTDirect)) -> [Maybe (CIQuote 'CTDirect)]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Maybe (CIQuote 'CTDirect))
quotedItems_) [Either ChatError SndMessage]
msgs_
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Either ChatError (NewSndChatItemData 'CTDirect)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either ChatError (NewSndChatItemData 'CTDirect)]
itemsData Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty ComposedMessageReq -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty ComposedMessageReq
cmrs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logError Text
"sendContactContentMessages: cmrs and itemsData length mismatch"
          r :: ([ChatError], [ChatItem 'CTDirect 'MDSnd])
r@([ChatError]
_, [ChatItem 'CTDirect 'MDSnd]
cis) <- [Either ChatError (ChatItem 'CTDirect 'MDSnd)]
-> ([ChatError], [ChatItem 'CTDirect 'MDSnd])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError (ChatItem 'CTDirect 'MDSnd)]
 -> ([ChatError], [ChatItem 'CTDirect 'MDSnd]))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [Either ChatError (ChatItem 'CTDirect 'MDSnd)]
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [ChatItem 'CTDirect 'MDSnd])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User
-> ChatDirection 'CTDirect 'MDSnd
-> [Either ChatError (NewSndChatItemData 'CTDirect)]
-> Maybe CITimed
-> Bool
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [Either ChatError (ChatItem 'CTDirect 'MDSnd)]
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> [Either ChatError (NewSndChatItemData c)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem c 'MDSnd)]
saveSndChatItems User
user (Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd Contact
ct) [Either ChatError (NewSndChatItemData 'CTDirect)]
itemsData Maybe CITimed
timed_ Bool
live
          ([ChatError], [ChatItem 'CTDirect 'MDSnd])
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
([ChatError], [ChatItem c d])
-> ExceptT ChatError (ReaderT ChatController IO) ()
processSendErrs ([ChatError], [ChatItem 'CTDirect 'MDSnd])
r
          Maybe UTCTime
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe CITimed
timed_ Maybe CITimed -> (CITimed -> Maybe UTCTime) -> Maybe UTCTime
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CITimed -> Maybe UTCTime
timedDeleteAt') ((UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \UTCTime
deleteAt ->
            [ChatItem 'CTDirect 'MDSnd]
-> (ChatItem 'CTDirect 'MDSnd
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ChatItem 'CTDirect 'MDSnd]
cis ((ChatItem 'CTDirect 'MDSnd
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatItem 'CTDirect 'MDSnd
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \ChatItem 'CTDirect 'MDSnd
ci ->
              User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTDirect Int64
contactId Maybe GroupChatScope
forall a. Maybe a
Nothing, ChatItem 'CTDirect 'MDSnd -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem 'CTDirect 'MDSnd
ci) UTCTime
deleteAt
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatResponse
CRNewChatItems User
user ((ChatItem 'CTDirect 'MDSnd -> AChatItem)
-> [ChatItem 'CTDirect 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map (SChatType 'CTDirect
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTDirect
-> ChatItem 'CTDirect 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTDirect
SCTDirect SMsgDirection 'MDSnd
SMDSnd (Contact -> ChatInfo 'CTDirect
DirectChat Contact
ct)) [ChatItem 'CTDirect 'MDSnd]
cis)
          where
            setupSndFileTransfers :: CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
            setupSndFileTransfers :: ExceptT
  ChatError
  (ReaderT ChatController IO)
  (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
setupSndFileTransfers =
              NonEmpty ComposedMessageReq
-> (ComposedMessageReq
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty ComposedMessageReq
cmrs ((ComposedMessageReq
  -> ExceptT
       ChatError
       (ReaderT ChatController IO)
       (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))))
-> (ComposedMessageReq
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
forall a b. (a -> b) -> a -> b
$ \(ComposedMessage {fileSource :: ComposedMessage -> Maybe CryptoFile
fileSource = Maybe CryptoFile
file_}, Maybe CIForwardedFrom
_, (Text, Maybe MarkdownList)
_, Map Text CIMention
_) -> case Maybe CryptoFile
file_ of
                Just CryptoFile
file -> do
                  Integer
fileSize <- CryptoFile -> ExceptT ChatError (ReaderT ChatController IO) Integer
checkSndFile CryptoFile
file
                  (FileInvitation
fInv, CIFile 'MDSnd
ciFile) <- User
-> CryptoFile
-> Integer
-> Int
-> ContactOrGroup
-> CM (FileInvitation, CIFile 'MDSnd)
xftpSndFileTransfer User
user CryptoFile
file Integer
fileSize Int
1 (ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd))
-> ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd)
forall a b. (a -> b) -> a -> b
$ Contact -> ContactOrGroup
CGContact Contact
ct
                  (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileInvitation -> Maybe FileInvitation
forall a. a -> Maybe a
Just FileInvitation
fInv, CIFile 'MDSnd -> Maybe (CIFile 'MDSnd)
forall a. a -> Maybe a
Just CIFile 'MDSnd
ciFile)
                Maybe CryptoFile
Nothing -> (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileInvitation
forall a. Maybe a
Nothing, Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing)
            prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
            prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation)
-> Maybe CITimed
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
prepareMsgs NonEmpty (ComposedMessageReq, Maybe FileInvitation)
cmsFileInvs Maybe CITimed
timed_ = (Connection
 -> ExceptT
      StoreError IO (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError IO (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))))
-> (Connection
    -> ExceptT
         StoreError IO (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
              NonEmpty (ComposedMessageReq, Maybe FileInvitation)
-> ((ComposedMessageReq, Maybe FileInvitation)
    -> ExceptT StoreError IO (MsgContainer, Maybe (CIQuote 'CTDirect)))
-> ExceptT
     StoreError IO (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (ComposedMessageReq, Maybe FileInvitation)
cmsFileInvs (((ComposedMessageReq, Maybe FileInvitation)
  -> ExceptT StoreError IO (MsgContainer, Maybe (CIQuote 'CTDirect)))
 -> ExceptT
      StoreError IO (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect))))
-> ((ComposedMessageReq, Maybe FileInvitation)
    -> ExceptT StoreError IO (MsgContainer, Maybe (CIQuote 'CTDirect)))
-> ExceptT
     StoreError IO (NonEmpty (MsgContainer, Maybe (CIQuote 'CTDirect)))
forall a b. (a -> b) -> a -> b
$ \((ComposedMessage {Maybe Int64
quotedItemId :: ComposedMessage -> Maybe Int64
quotedItemId :: Maybe Int64
quotedItemId, msgContent :: ComposedMessage -> MsgContent
msgContent = MsgContent
mc}, Maybe CIForwardedFrom
itemForwarded, (Text, Maybe MarkdownList)
_, Map Text CIMention
_), Maybe FileInvitation
fInv_) -> do
                case (Maybe Int64
quotedItemId, Maybe CIForwardedFrom
itemForwarded) of
                  (Maybe Int64
Nothing, Maybe CIForwardedFrom
Nothing) -> (MsgContainer, Maybe (CIQuote 'CTDirect))
-> ExceptT StoreError IO (MsgContainer, Maybe (CIQuote 'CTDirect))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtMsgContent -> MsgContainer
MCSimple (MsgContent
-> Map Text MsgMention
-> Maybe FileInvitation
-> Maybe Int
-> Maybe Bool
-> Maybe MsgScope
-> ExtMsgContent
ExtMsgContent MsgContent
mc Map Text MsgMention
forall k a. Map k a
M.empty Maybe FileInvitation
fInv_ (CITimed -> Int
ttl' (CITimed -> Int) -> Maybe CITimed -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CITimed
timed_) (Bool -> Maybe Bool
justTrue Bool
live) Maybe MsgScope
forall a. Maybe a
Nothing), Maybe (CIQuote 'CTDirect)
forall a. Maybe a
Nothing)
                  (Maybe Int64
Nothing, Just CIForwardedFrom
_) -> (MsgContainer, Maybe (CIQuote 'CTDirect))
-> ExceptT StoreError IO (MsgContainer, Maybe (CIQuote 'CTDirect))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExtMsgContent -> MsgContainer
MCForward (MsgContent
-> Map Text MsgMention
-> Maybe FileInvitation
-> Maybe Int
-> Maybe Bool
-> Maybe MsgScope
-> ExtMsgContent
ExtMsgContent MsgContent
mc Map Text MsgMention
forall k a. Map k a
M.empty Maybe FileInvitation
fInv_ (CITimed -> Int
ttl' (CITimed -> Int) -> Maybe CITimed -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CITimed
timed_) (Bool -> Maybe Bool
justTrue Bool
live) Maybe MsgScope
forall a. Maybe a
Nothing), Maybe (CIQuote 'CTDirect)
forall a. Maybe a
Nothing)
                  (Just Int64
qiId, Maybe CIForwardedFrom
Nothing) -> do
                    CChatItem SMsgDirection d
_ qci :: ChatItem 'CTDirect d
qci@ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {UTCTime
itemTs :: forall (c :: ChatType) (d :: MsgDirection). CIMeta c d -> UTCTime
itemTs :: UTCTime
itemTs, Maybe SharedMsgId
itemSharedMsgId :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe SharedMsgId
itemSharedMsgId :: Maybe SharedMsgId
itemSharedMsgId}, Maybe MarkdownList
formattedText :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText, Maybe (CIFile d)
file :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> Maybe (CIFile d)
file :: Maybe (CIFile d)
file} <-
                      Connection
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user Int64
contactId Int64
qiId
                    (MsgContent
origQmc, CIQDirection 'CTDirect
qd, Bool
sent) <- ChatItem 'CTDirect d
-> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData ChatItem 'CTDirect d
qci
                    let msgRef :: MsgRef
msgRef = MsgRef {msgId :: Maybe SharedMsgId
msgId = Maybe SharedMsgId
itemSharedMsgId, sentAt :: UTCTime
sentAt = UTCTime
itemTs, Bool
sent :: Bool
sent :: Bool
sent, memberId :: Maybe MemberId
memberId = Maybe MemberId
forall a. Maybe a
Nothing}
                        qmc :: MsgContent
qmc = MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent
forall (d :: MsgDirection).
MsgContent -> MsgContent -> Maybe (CIFile d) -> MsgContent
quoteContent MsgContent
mc MsgContent
origQmc Maybe (CIFile d)
file
                        quotedItem :: CIQuote 'CTDirect
quotedItem = CIQuote {chatDir :: CIQDirection 'CTDirect
chatDir = CIQDirection 'CTDirect
qd, itemId :: Maybe Int64
itemId = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
qiId, sharedMsgId :: Maybe SharedMsgId
sharedMsgId = Maybe SharedMsgId
itemSharedMsgId, sentAt :: UTCTime
sentAt = UTCTime
itemTs, content :: MsgContent
content = MsgContent
qmc, Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText :: Maybe MarkdownList
formattedText}
                    (MsgContainer, Maybe (CIQuote 'CTDirect))
-> ExceptT StoreError IO (MsgContainer, Maybe (CIQuote 'CTDirect))
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QuotedMsg -> ExtMsgContent -> MsgContainer
MCQuote QuotedMsg {MsgRef
msgRef :: MsgRef
msgRef :: MsgRef
msgRef, content :: MsgContent
content = MsgContent
qmc} (MsgContent
-> Map Text MsgMention
-> Maybe FileInvitation
-> Maybe Int
-> Maybe Bool
-> Maybe MsgScope
-> ExtMsgContent
ExtMsgContent MsgContent
mc Map Text MsgMention
forall k a. Map k a
M.empty Maybe FileInvitation
fInv_ (CITimed -> Int
ttl' (CITimed -> Int) -> Maybe CITimed -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CITimed
timed_) (Bool -> Maybe Bool
justTrue Bool
live) Maybe MsgScope
forall a. Maybe a
Nothing), CIQuote 'CTDirect -> Maybe (CIQuote 'CTDirect)
forall a. a -> Maybe a
Just CIQuote 'CTDirect
quotedItem)
                  (Just Int64
_, Just CIForwardedFrom
_) -> StoreError
-> ExceptT StoreError IO (MsgContainer, Maybe (CIQuote 'CTDirect))
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEInvalidQuote
              where
                quoteData :: ChatItem c d -> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
                quoteData :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d
-> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
quoteData ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {itemDeleted :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted = Just CIDeleted c
_}} = StoreError
-> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEInvalidQuote
                quoteData ChatItem {content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CISndMsgContent MsgContent
qmc} = (MsgContent, CIQDirection 'CTDirect, Bool)
-> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MsgContent
qmc, CIQDirection 'CTDirect
CIQDirectSnd, Bool
True)
                quoteData ChatItem {content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CIRcvMsgContent MsgContent
qmc} = (MsgContent, CIQDirection 'CTDirect, Bool)
-> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
forall a. a -> ExceptT StoreError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MsgContent
qmc, CIQDirection 'CTDirect
CIQDirectRcv, Bool
False)
                quoteData ChatItem c d
_ = StoreError
-> ExceptT StoreError IO (MsgContent, CIQDirection 'CTDirect, Bool)
forall a. StoreError -> ExceptT StoreError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StoreError
SEInvalidQuote
    sendGroupContentMessages :: User -> GroupInfo -> Maybe GroupChatScope -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
    sendGroupContentMessages :: User
-> GroupInfo
-> Maybe GroupChatScope
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendGroupContentMessages User
user GroupInfo
gInfo Maybe GroupChatScope
scope Bool
live Maybe Int
itemTTL NonEmpty ComposedMessageReq
cmrs = do
      Bool
-> NonEmpty ComposedMessageReq
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertMultiSendable Bool
live NonEmpty ComposedMessageReq
cmrs
      Maybe GroupChatScopeInfo
chatScopeInfo <- (GroupChatScope
 -> ExceptT
      ChatError (ReaderT ChatController IO) GroupChatScopeInfo)
-> Maybe GroupChatScope
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe GroupChatScopeInfo)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (VersionRangeChat
-> User
-> GroupChatScope
-> ExceptT ChatError (ReaderT ChatController IO) GroupChatScopeInfo
getChatScopeInfo VersionRangeChat
vr User
user) Maybe GroupChatScope
scope
      [GroupMember]
recipients <- VersionRangeChat
-> User
-> GroupInfo
-> Maybe GroupChatScopeInfo
-> Version ChatVersion
-> CM [GroupMember]
getGroupRecipients VersionRangeChat
vr User
user GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo Version ChatVersion
modsCompatVersion
      User
-> GroupInfo
-> Maybe GroupChatScope
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendGroupContentMessages_ User
user GroupInfo
gInfo Maybe GroupChatScope
scope Maybe GroupChatScopeInfo
chatScopeInfo [GroupMember]
recipients Bool
live Maybe Int
itemTTL NonEmpty ComposedMessageReq
cmrs
        where
          hasReport :: Bool
hasReport = (ComposedMessageReq -> Bool) -> NonEmpty ComposedMessageReq -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ComposedMessage {MsgContent
msgContent :: ComposedMessage -> MsgContent
msgContent :: MsgContent
msgContent}, Maybe CIForwardedFrom
_, (Text, Maybe MarkdownList)
_, Map Text CIMention
_) -> MsgContent -> Bool
isReport MsgContent
msgContent) NonEmpty ComposedMessageReq
cmrs
          modsCompatVersion :: Version ChatVersion
modsCompatVersion = if Bool
hasReport then Version ChatVersion
contentReportsVersion else Version ChatVersion
groupKnockingVersion
    sendGroupContentMessages_ :: User -> GroupInfo -> Maybe GroupChatScope -> Maybe GroupChatScopeInfo -> [GroupMember] -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
    sendGroupContentMessages_ :: User
-> GroupInfo
-> Maybe GroupChatScope
-> Maybe GroupChatScopeInfo
-> [GroupMember]
-> Bool
-> Maybe Int
-> NonEmpty ComposedMessageReq
-> CM ChatResponse
sendGroupContentMessages_ User
user gInfo :: GroupInfo
gInfo@GroupInfo {Int64
groupId :: GroupInfo -> Int64
groupId :: Int64
groupId, GroupMember
membership :: GroupInfo -> GroupMember
membership :: GroupMember
membership} Maybe GroupChatScope
scope Maybe GroupChatScopeInfo
chatScopeInfo [GroupMember]
recipients Bool
live Maybe Int
itemTTL NonEmpty ComposedMessageReq
cmrs = do
      Maybe GroupMemberRole
-> (GroupMemberRole
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GroupMemberRole
allowedRole ((GroupMemberRole
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (GroupMemberRole
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ GroupInfo
-> GroupMemberRole
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertUserGroupRole GroupInfo
gInfo
      ExceptT ChatError (ReaderT ChatController IO) ()
assertGroupContentAllowed
      CM ChatResponse
processComposedMessages
      where
        allowedRole :: Maybe GroupMemberRole
        allowedRole :: Maybe GroupMemberRole
allowedRole = case Maybe GroupChatScope
scope of
          Maybe GroupChatScope
Nothing -> GroupMemberRole -> Maybe GroupMemberRole
forall a. a -> Maybe a
Just GroupMemberRole
GRAuthor
          Just (GCSMemberSupport Maybe Int64
Nothing)
            | GroupMember -> Bool
memberPending GroupMember
membership -> Maybe GroupMemberRole
forall a. Maybe a
Nothing
            | Bool
otherwise -> GroupMemberRole -> Maybe GroupMemberRole
forall a. a -> Maybe a
Just GroupMemberRole
GRObserver
          Just (GCSMemberSupport (Just Int64
_gmId)) -> GroupMemberRole -> Maybe GroupMemberRole
forall a. a -> Maybe a
Just GroupMemberRole
GRModerator
        assertGroupContentAllowed :: CM ()
        assertGroupContentAllowed :: ExceptT ChatError (ReaderT ChatController IO) ()
assertGroupContentAllowed =
          case [ComposedMessageReq] -> Maybe GroupFeature
findProhibited (NonEmpty ComposedMessageReq -> [ComposedMessageReq]
forall a. NonEmpty a -> [a]
L.toList NonEmpty ComposedMessageReq
cmrs) of
            Just GroupFeature
f -> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError (String -> ExceptT ChatError (ReaderT ChatController IO) ())
-> String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ String
"feature not allowed " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (GroupFeature -> Text
groupFeatureNameText GroupFeature
f)
            Maybe GroupFeature
Nothing -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          where
            findProhibited :: [ComposedMessageReq] -> Maybe GroupFeature
            findProhibited :: [ComposedMessageReq] -> Maybe GroupFeature
findProhibited =
              (ComposedMessageReq -> Maybe GroupFeature -> Maybe GroupFeature)
-> Maybe GroupFeature -> [ComposedMessageReq] -> Maybe GroupFeature
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr'
                (\(ComposedMessage {Maybe CryptoFile
fileSource :: ComposedMessage -> Maybe CryptoFile
fileSource :: Maybe CryptoFile
fileSource, msgContent :: ComposedMessage -> MsgContent
msgContent = MsgContent
mc}, Maybe CIForwardedFrom
_, (Text
_, Maybe MarkdownList
ft), Map Text CIMention
_) Maybe GroupFeature
acc -> GroupInfo
-> GroupMember
-> Maybe GroupChatScopeInfo
-> MsgContent
-> Maybe MarkdownList
-> Maybe CryptoFile
-> Bool
-> Maybe GroupFeature
forall f.
GroupInfo
-> GroupMember
-> Maybe GroupChatScopeInfo
-> MsgContent
-> Maybe MarkdownList
-> Maybe f
-> Bool
-> Maybe GroupFeature
prohibitedGroupContent GroupInfo
gInfo GroupMember
membership Maybe GroupChatScopeInfo
chatScopeInfo MsgContent
mc Maybe MarkdownList
ft Maybe CryptoFile
fileSource Bool
True Maybe GroupFeature -> Maybe GroupFeature -> Maybe GroupFeature
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe GroupFeature
acc)
                Maybe GroupFeature
forall a. Maybe a
Nothing
        processComposedMessages ::  CM ChatResponse
        processComposedMessages :: CM ChatResponse
processComposedMessages = do
          -- TODO [channels fwd] single description for all recipients
          (NonEmpty (Maybe FileInvitation)
fInvs_, NonEmpty (Maybe (CIFile 'MDSnd))
ciFiles_) <- NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
-> (NonEmpty (Maybe FileInvitation),
    NonEmpty (Maybe (CIFile 'MDSnd)))
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
L.unzip (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
 -> (NonEmpty (Maybe FileInvitation),
     NonEmpty (Maybe (CIFile 'MDSnd))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation), NonEmpty (Maybe (CIFile 'MDSnd)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
setupSndFileTransfers ([GroupMember] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMember]
recipients)
          Maybe CITimed
timed_ <- Bool -> GroupInfo -> Maybe Int -> CM (Maybe CITimed)
sndGroupCITimed Bool
live GroupInfo
gInfo Maybe Int
itemTTL
          (NonEmpty (ChatMsgEvent 'Json)
chatMsgEvents, NonEmpty (Maybe (CIQuote 'CTGroup))
quotedItems_) <- NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))
-> (NonEmpty (ChatMsgEvent 'Json),
    NonEmpty (Maybe (CIQuote 'CTGroup)))
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
L.unzip (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))
 -> (NonEmpty (ChatMsgEvent 'Json),
     NonEmpty (Maybe (CIQuote 'CTGroup))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (ChatMsgEvent 'Json),
      NonEmpty (Maybe (CIQuote 'CTGroup)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ComposedMessageReq, Maybe FileInvitation)
-> Maybe CITimed
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
prepareMsgs (NonEmpty ComposedMessageReq
-> NonEmpty (Maybe FileInvitation)
-> NonEmpty (ComposedMessageReq, Maybe FileInvitation)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
L.zip NonEmpty ComposedMessageReq
cmrs NonEmpty (Maybe FileInvitation)
fInvs_) Maybe CITimed
timed_
          (NonEmpty (Either ChatError SndMessage)
msgs_, GroupSndResult
gsr) <- User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent 'Json)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
forall (e :: MsgEncoding).
MsgEncodingI e =>
User
-> GroupInfo
-> Maybe GroupChatScope
-> [GroupMember]
-> NonEmpty (ChatMsgEvent e)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages User
user GroupInfo
gInfo Maybe GroupChatScope
forall a. Maybe a
Nothing [GroupMember]
recipients NonEmpty (ChatMsgEvent 'Json)
chatMsgEvents
          let itemsData :: [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData = [ComposedMessageReq]
-> [Maybe (CIFile 'MDSnd)]
-> [Maybe (CIQuote 'CTGroup)]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
forall (c :: ChatType).
[ComposedMessageReq]
-> [Maybe (CIFile 'MDSnd)]
-> [Maybe (CIQuote c)]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData c)]
prepareSndItemsData (NonEmpty ComposedMessageReq -> [ComposedMessageReq]
forall a. NonEmpty a -> [a]
L.toList NonEmpty ComposedMessageReq
cmrs) (NonEmpty (Maybe (CIFile 'MDSnd)) -> [Maybe (CIFile 'MDSnd)]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Maybe (CIFile 'MDSnd))
ciFiles_) (NonEmpty (Maybe (CIQuote 'CTGroup)) -> [Maybe (CIQuote 'CTGroup)]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Maybe (CIQuote 'CTGroup))
quotedItems_) (NonEmpty (Either ChatError SndMessage)
-> [Either ChatError SndMessage]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Either ChatError SndMessage)
msgs_)
          [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ <- User
-> ChatDirection 'CTGroup 'MDSnd
-> [Either ChatError (NewSndChatItemData 'CTGroup)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
forall (c :: ChatType).
ChatTypeI c =>
User
-> ChatDirection c 'MDSnd
-> [Either ChatError (NewSndChatItemData c)]
-> Maybe CITimed
-> Bool
-> CM [Either ChatError (ChatItem c 'MDSnd)]
saveSndChatItems User
user (GroupInfo
-> Maybe GroupChatScopeInfo -> ChatDirection 'CTGroup 'MDSnd
CDGroupSnd GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo) [Either ChatError (NewSndChatItemData 'CTGroup)]
itemsData Maybe CITimed
timed_ Bool
live
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Either ChatError (ChatItem 'CTGroup 'MDSnd)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty ComposedMessageReq -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty ComposedMessageReq
cmrs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logError Text
"sendGroupContentMessages: cmrs and cis_ length mismatch"
          [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> NonEmpty (Either ChatError SndMessage)
-> GroupSndResult
-> ExceptT ChatError (ReaderT ChatController IO) ()
createMemberSndStatuses [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ NonEmpty (Either ChatError SndMessage)
msgs_ GroupSndResult
gsr
          let r :: ([ChatError], [ChatItem 'CTGroup 'MDSnd])
r@([ChatError]
_, [ChatItem 'CTGroup 'MDSnd]
cis) = [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> ([ChatError], [ChatItem 'CTGroup 'MDSnd])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_
          ([ChatError], [ChatItem 'CTGroup 'MDSnd])
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (c :: ChatType) (d :: MsgDirection).
([ChatError], [ChatItem c d])
-> ExceptT ChatError (ReaderT ChatController IO) ()
processSendErrs ([ChatError], [ChatItem 'CTGroup 'MDSnd])
r
          Maybe UTCTime
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe CITimed
timed_ Maybe CITimed -> (CITimed -> Maybe UTCTime) -> Maybe UTCTime
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CITimed -> Maybe UTCTime
timedDeleteAt') ((UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \UTCTime
deleteAt ->
            [ChatItem 'CTGroup 'MDSnd]
-> (ChatItem 'CTGroup 'MDSnd
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ChatItem 'CTGroup 'MDSnd]
cis ((ChatItem 'CTGroup 'MDSnd
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatItem 'CTGroup 'MDSnd
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \ChatItem 'CTGroup 'MDSnd
ci ->
              User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startProximateTimedItemThread User
user (ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup Int64
groupId Maybe GroupChatScope
scope, ChatItem 'CTGroup 'MDSnd -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem 'CTGroup 'MDSnd
ci) UTCTime
deleteAt
          ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatResponse
CRNewChatItems User
user ((ChatItem 'CTGroup 'MDSnd -> AChatItem)
-> [ChatItem 'CTGroup 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map (SChatType 'CTGroup
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTGroup
-> ChatItem 'CTGroup 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTGroup
SCTGroup SMsgDirection 'MDSnd
SMDSnd (GroupInfo -> Maybe GroupChatScopeInfo -> ChatInfo 'CTGroup
GroupChat GroupInfo
gInfo Maybe GroupChatScopeInfo
chatScopeInfo)) [ChatItem 'CTGroup 'MDSnd]
cis)
          where
            setupSndFileTransfers :: Int -> CM (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
            setupSndFileTransfers :: Int
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
setupSndFileTransfers Int
n =
              NonEmpty ComposedMessageReq
-> (ComposedMessageReq
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty ComposedMessageReq
cmrs ((ComposedMessageReq
  -> ExceptT
       ChatError
       (ReaderT ChatController IO)
       (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd))))
-> (ComposedMessageReq
    -> ExceptT
         ChatError
         (ReaderT ChatController IO)
         (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (Maybe FileInvitation, Maybe (CIFile 'MDSnd)))
forall a b. (a -> b) -> a -> b
$ \(ComposedMessage {fileSource :: ComposedMessage -> Maybe CryptoFile
fileSource = Maybe CryptoFile
file_}, Maybe CIForwardedFrom
_, (Text, Maybe MarkdownList)
_, Map Text CIMention
_) -> case Maybe CryptoFile
file_ of
                Just CryptoFile
file -> do
                  Integer
fileSize <- CryptoFile -> ExceptT ChatError (ReaderT ChatController IO) Integer
checkSndFile CryptoFile
file
                  (FileInvitation
fInv, CIFile 'MDSnd
ciFile) <- User
-> CryptoFile
-> Integer
-> Int
-> ContactOrGroup
-> CM (FileInvitation, CIFile 'MDSnd)
xftpSndFileTransfer User
user CryptoFile
file Integer
fileSize Int
n (ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd))
-> ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd)
forall a b. (a -> b) -> a -> b
$ GroupInfo -> [GroupMember] -> ContactOrGroup
CGGroup GroupInfo
gInfo [GroupMember]
recipients
                  (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileInvitation -> Maybe FileInvitation
forall a. a -> Maybe a
Just FileInvitation
fInv, CIFile 'MDSnd -> Maybe (CIFile 'MDSnd)
forall a. a -> Maybe a
Just CIFile 'MDSnd
ciFile)
                Maybe CryptoFile
Nothing -> (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (Maybe FileInvitation, Maybe (CIFile 'MDSnd))
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FileInvitation
forall a. Maybe a
Nothing, Maybe (CIFile 'MDSnd)
forall a. Maybe a
Nothing)
            prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation) -> Maybe CITimed -> CM (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
            prepareMsgs :: NonEmpty (ComposedMessageReq, Maybe FileInvitation)
-> Maybe CITimed
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
prepareMsgs NonEmpty (ComposedMessageReq, Maybe FileInvitation)
cmsFileInvs Maybe CITimed
timed_ = (Connection
 -> ExceptT
      StoreError
      IO
      (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection
  -> ExceptT
       StoreError
       IO
       (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))))
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))))
-> (Connection
    -> ExceptT
         StoreError
         IO
         (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))))
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
forall a b. (a -> b) -> a -> b
$ \Connection
db ->
              NonEmpty (ComposedMessageReq, Maybe FileInvitation)
-> ((ComposedMessageReq, Maybe FileInvitation)
    -> ExceptT
         StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
-> ExceptT
     StoreError
     IO
     (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (ComposedMessageReq, Maybe FileInvitation)
cmsFileInvs (((ComposedMessageReq, Maybe FileInvitation)
  -> ExceptT
       StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
 -> ExceptT
      StoreError
      IO
      (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))))
-> ((ComposedMessageReq, Maybe FileInvitation)
    -> ExceptT
         StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
-> ExceptT
     StoreError
     IO
     (NonEmpty (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup)))
forall a b. (a -> b) -> a -> b
$ \((ComposedMessage {Maybe Int64
quotedItemId :: ComposedMessage -> Maybe Int64
quotedItemId :: Maybe Int64
quotedItemId, msgContent :: ComposedMessage -> MsgContent
msgContent = MsgContent
mc}, Maybe CIForwardedFrom
itemForwarded, (Text, Maybe MarkdownList)
_, Map Text CIMention
ciMentions), Maybe FileInvitation
fInv_) ->
                let msgScope :: Maybe MsgScope
msgScope = GroupInfo -> GroupChatScopeInfo -> MsgScope
toMsgScope GroupInfo
gInfo (GroupChatScopeInfo -> MsgScope)
-> Maybe GroupChatScopeInfo -> Maybe MsgScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GroupChatScopeInfo
chatScopeInfo
                    mentions :: Map Text MsgMention
mentions = (CIMention -> MsgMention)
-> Map Text CIMention -> Map Text MsgMention
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\CIMention {MemberId
memberId :: CIMention -> MemberId
memberId :: MemberId
memberId} -> MsgMention {MemberId
memberId :: MemberId
memberId :: MemberId
memberId}) Map Text CIMention
ciMentions
                 in Connection
-> User
-> GroupInfo
-> Maybe MsgScope
-> MsgContent
-> Map Text MsgMention
-> Maybe Int64
-> Maybe CIForwardedFrom
-> Maybe FileInvitation
-> Maybe CITimed
-> Bool
-> ExceptT
     StoreError IO (ChatMsgEvent 'Json, Maybe (CIQuote 'CTGroup))
prepareGroupMsg Connection
db User
user GroupInfo
gInfo Maybe MsgScope
msgScope MsgContent
mc Map Text MsgMention
mentions Maybe Int64
quotedItemId Maybe CIForwardedFrom
itemForwarded Maybe FileInvitation
fInv_ Maybe CITimed
timed_ Bool
live
            createMemberSndStatuses ::
              [Either ChatError (ChatItem 'CTGroup 'MDSnd)] ->
              NonEmpty (Either ChatError SndMessage) ->
              GroupSndResult ->
              CM ()
            createMemberSndStatuses :: [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> NonEmpty (Either ChatError SndMessage)
-> GroupSndResult
-> ExceptT ChatError (ReaderT ChatController IO) ()
createMemberSndStatuses [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ NonEmpty (Either ChatError SndMessage)
msgs_ GroupSndResult {[(Int64, Either ChatError [Int64],
  Either ChatError ([Int64], PQEncryption))]
sentTo :: [(Int64, Either ChatError [Int64],
  Either ChatError ([Int64], PQEncryption))]
sentTo :: GroupSndResult
-> [(Int64, Either ChatError [Int64],
     Either ChatError ([Int64], PQEncryption))]
sentTo, [(Int64, Either ChatError Int64, Either ChatError ())]
pending :: [(Int64, Either ChatError Int64, Either ChatError ())]
pending :: GroupSndResult
-> [(Int64, Either ChatError Int64, Either ChatError ())]
pending, [GroupMember]
forwarded :: [GroupMember]
forwarded :: GroupSndResult -> [GroupMember]
forwarded} = do
              let msgToItem :: Map Int64 Int64
msgToItem = Map Int64 Int64
mapMsgToItem
              (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
                [(Int64, Either ChatError [Int64],
  Either ChatError ([Int64], PQEncryption))]
-> ((Int64, Either ChatError [Int64],
     Either ChatError ([Int64], PQEncryption))
    -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64, Either ChatError [Int64],
  Either ChatError ([Int64], PQEncryption))]
sentTo (Connection
-> Map Int64 Int64
-> (Int64, Either ChatError [Int64],
    Either ChatError ([Int64], PQEncryption))
-> IO ()
processSentTo Connection
db Map Int64 Int64
msgToItem)
                [GroupMember] -> (GroupMember -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMember]
forwarded (Connection -> GroupMember -> IO ()
processForwarded Connection
db)
                [(Int64, Either ChatError Int64, Either ChatError ())]
-> ((Int64, Either ChatError Int64, Either ChatError ()) -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Int64, Either ChatError Int64, Either ChatError ())]
pending (Connection
-> Map Int64 Int64
-> (Int64, Either ChatError Int64, Either ChatError ())
-> IO ()
processPending Connection
db Map Int64 Int64
msgToItem)
              where
                mapMsgToItem :: Map MessageId ChatItemId
                mapMsgToItem :: Map Int64 Int64
mapMsgToItem = ((Either ChatError SndMessage,
  Either ChatError (ChatItem 'CTGroup 'MDSnd))
 -> Map Int64 Int64 -> Map Int64 Int64)
-> Map Int64 Int64
-> [(Either ChatError SndMessage,
     Either ChatError (ChatItem 'CTGroup 'MDSnd))]
-> Map Int64 Int64
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (Either ChatError SndMessage,
 Either ChatError (ChatItem 'CTGroup 'MDSnd))
-> Map Int64 Int64 -> Map Int64 Int64
forall {a} {a} {c :: ChatType} {d :: MsgDirection}.
(Either a SndMessage, Either a (ChatItem c d))
-> Map Int64 Int64 -> Map Int64 Int64
addItem Map Int64 Int64
forall k a. Map k a
M.empty ([Either ChatError SndMessage]
-> [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> [(Either ChatError SndMessage,
     Either ChatError (ChatItem 'CTGroup 'MDSnd))]
forall a b. [a] -> [b] -> [(a, b)]
zip (NonEmpty (Either ChatError SndMessage)
-> [Either ChatError SndMessage]
forall a. NonEmpty a -> [a]
L.toList NonEmpty (Either ChatError SndMessage)
msgs_) [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_)
                  where
                    addItem :: (Either a SndMessage, Either a (ChatItem c d))
-> Map Int64 Int64 -> Map Int64 Int64
addItem (Right SndMessage {Int64
msgId :: SndMessage -> Int64
msgId :: Int64
msgId}, Right ChatItem c d
ci) Map Int64 Int64
m = Int64 -> Int64 -> Map Int64 Int64 -> Map Int64 Int64
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int64
msgId (ChatItem c d -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem c d
ci) Map Int64 Int64
m
                    addItem (Either a SndMessage, Either a (ChatItem c d))
_ Map Int64 Int64
m = Map Int64 Int64
m
                processSentTo :: DB.Connection -> Map MessageId ChatItemId -> (GroupMemberId, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption)) -> IO ()
                processSentTo :: Connection
-> Map Int64 Int64
-> (Int64, Either ChatError [Int64],
    Either ChatError ([Int64], PQEncryption))
-> IO ()
processSentTo Connection
db Map Int64 Int64
msgToItem (Int64
mId, Either ChatError [Int64]
msgIds_, Either ChatError ([Int64], PQEncryption)
deliveryResult) = Either ChatError [Int64] -> ([Int64] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Either ChatError [Int64]
msgIds_ (([Int64] -> IO ()) -> IO ()) -> ([Int64] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Int64]
msgIds -> do
                  let ciIds :: [Int64]
ciIds = (Int64 -> Maybe Int64) -> [Int64] -> [Int64]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int64 -> Map Int64 Int64 -> Maybe Int64
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Int64 Int64
msgToItem) [Int64]
msgIds
                      status :: GroupSndStatus
status = case Either ChatError ([Int64], PQEncryption)
deliveryResult of
                        Right ([Int64], PQEncryption)
_ -> GroupSndStatus
GSSNew
                        Left ChatError
e -> SndError -> GroupSndStatus
GSSError (SndError -> GroupSndStatus) -> SndError -> GroupSndStatus
forall a b. (a -> b) -> a -> b
$ Text -> SndError
SndErrOther (Text -> SndError) -> Text -> SndError
forall a b. (a -> b) -> a -> b
$ ChatError -> Text
forall a. Show a => a -> Text
tshow ChatError
e
                  [Int64] -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int64]
ciIds ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
ciId -> Connection -> Int64 -> Int64 -> GroupSndStatus -> IO ()
createGroupSndStatus Connection
db Int64
ciId Int64
mId GroupSndStatus
status
                processForwarded :: DB.Connection -> GroupMember -> IO ()
                processForwarded :: Connection -> GroupMember -> IO ()
processForwarded Connection
db GroupMember {Int64
groupMemberId :: GroupMember -> Int64
groupMemberId :: Int64
groupMemberId} =
                  [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
-> (Either ChatError (ChatItem 'CTGroup 'MDSnd) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Either ChatError (ChatItem 'CTGroup 'MDSnd)]
cis_ ((Either ChatError (ChatItem 'CTGroup 'MDSnd) -> IO ()) -> IO ())
-> (Either ChatError (ChatItem 'CTGroup 'MDSnd) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Either ChatError (ChatItem 'CTGroup 'MDSnd)
ci_ ->
                    Either ChatError (ChatItem 'CTGroup 'MDSnd)
-> (ChatItem 'CTGroup 'MDSnd -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Either ChatError (ChatItem 'CTGroup 'MDSnd)
ci_ ((ChatItem 'CTGroup 'MDSnd -> IO ()) -> IO ())
-> (ChatItem 'CTGroup 'MDSnd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ChatItem 'CTGroup 'MDSnd
ci -> Connection -> Int64 -> Int64 -> GroupSndStatus -> IO ()
createGroupSndStatus Connection
db (ChatItem 'CTGroup 'MDSnd -> Int64
forall (c :: ChatType) (d :: MsgDirection). ChatItem c d -> Int64
chatItemId' ChatItem 'CTGroup 'MDSnd
ci) Int64
groupMemberId GroupSndStatus
GSSForwarded
                processPending :: DB.Connection -> Map MessageId ChatItemId -> (GroupMemberId, Either ChatError MessageId, Either ChatError ()) -> IO ()
                processPending :: Connection
-> Map Int64 Int64
-> (Int64, Either ChatError Int64, Either ChatError ())
-> IO ()
processPending Connection
db Map Int64 Int64
msgToItem (Int64
mId, Either ChatError Int64
msgId_, Either ChatError ()
pendingResult) = Either ChatError Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Either ChatError Int64
msgId_ ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
msgId -> do
                  let ciId_ :: Maybe Int64
ciId_ = Int64 -> Map Int64 Int64 -> Maybe Int64
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int64
msgId Map Int64 Int64
msgToItem
                      status :: GroupSndStatus
status = case Either ChatError ()
pendingResult of
                        Right ()
_ -> GroupSndStatus
GSSInactive
                        Left ChatError
e -> SndError -> GroupSndStatus
GSSError (SndError -> GroupSndStatus) -> SndError -> GroupSndStatus
forall a b. (a -> b) -> a -> b
$ Text -> SndError
SndErrOther (Text -> SndError) -> Text -> SndError
forall a b. (a -> b) -> a -> b
$ ChatError -> Text
forall a. Show a => a -> Text
tshow ChatError
e
                  Maybe Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int64
ciId_ ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
ciId -> Connection -> Int64 -> Int64 -> GroupSndStatus -> IO ()
createGroupSndStatus Connection
db Int64
ciId Int64
mId GroupSndStatus
status
    assertMultiSendable :: Bool -> NonEmpty ComposedMessageReq -> CM ()
    assertMultiSendable :: Bool
-> NonEmpty ComposedMessageReq
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertMultiSendable Bool
live NonEmpty ComposedMessageReq
cmrs
      | NonEmpty ComposedMessageReq -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty ComposedMessageReq
cmrs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise =
          -- When sending multiple messages only single quote is allowed.
          -- This is to support case of sending multiple attachments while also quoting another message.
          -- UI doesn't allow composing with multiple quotes, so api prohibits it as well, and doesn't bother
          -- batching retrieval of quoted messages (prepareMsgs).
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
live Bool -> Bool -> Bool
|| [ComposedMessageReq] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((ComposedMessageReq -> Bool)
-> NonEmpty ComposedMessageReq -> [ComposedMessageReq]
forall a. (a -> Bool) -> NonEmpty a -> [a]
L.filter (\(ComposedMessage {Maybe Int64
quotedItemId :: ComposedMessage -> Maybe Int64
quotedItemId :: Maybe Int64
quotedItemId}, Maybe CIForwardedFrom
_, (Text, Maybe MarkdownList)
_, Map Text CIMention
_) -> Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int64
quotedItemId) NonEmpty ComposedMessageReq
cmrs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
            String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"invalid multi send: live and more than one quote not supported"
    xftpSndFileTransfer :: User -> CryptoFile -> Integer -> Int -> ContactOrGroup -> CM (FileInvitation, CIFile 'MDSnd)
    xftpSndFileTransfer :: User
-> CryptoFile
-> Integer
-> Int
-> ContactOrGroup
-> CM (FileInvitation, CIFile 'MDSnd)
xftpSndFileTransfer User
user CryptoFile
file Integer
fileSize Int
n ContactOrGroup
contactOrGroup = do
      (FileInvitation
fInv, CIFile 'MDSnd
ciFile, FileTransferMeta
ft) <- User
-> CryptoFile
-> Integer
-> Int
-> Maybe ContactOrGroup
-> CM (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
xftpSndFileTransfer_ User
user CryptoFile
file Integer
fileSize Int
n (Maybe ContactOrGroup
 -> CM (FileInvitation, CIFile 'MDSnd, FileTransferMeta))
-> Maybe ContactOrGroup
-> CM (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
forall a b. (a -> b) -> a -> b
$ ContactOrGroup -> Maybe ContactOrGroup
forall a. a -> Maybe a
Just ContactOrGroup
contactOrGroup
      case ContactOrGroup
contactOrGroup of
        CGContact Contact {Maybe Connection
activeConn :: Contact -> Maybe Connection
activeConn :: Maybe Connection
activeConn} -> Maybe Connection
-> (Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Connection
activeConn ((Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
          (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User
-> Maybe GroupMember
-> Connection
-> FileTransferMeta
-> FileDescr
-> IO ()
createSndFTDescrXFTP Connection
db User
user Maybe GroupMember
forall a. Maybe a
Nothing Connection
conn FileTransferMeta
ft FileDescr
dummyFileDescr
        CGGroup GroupInfo
_ [GroupMember]
ms -> [GroupMember]
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMember]
ms ((GroupMember -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \GroupMember
m -> GroupMember -> ExceptT ChatError (ReaderT ChatController IO) ()
saveMemberFD GroupMember
m ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
          where
            -- we are not sending files to pending members, same as with inline files
            saveMemberFD :: GroupMember -> ExceptT ChatError (ReaderT ChatController IO) ()
saveMemberFD m :: GroupMember
m@GroupMember {activeConn :: GroupMember -> Maybe Connection
activeConn = Just conn :: Connection
conn@Connection {ConnStatus
connStatus :: Connection -> ConnStatus
connStatus :: ConnStatus
connStatus}} =
              Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnReady Bool -> Bool -> Bool
|| ConnStatus
connStatus ConnStatus -> ConnStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ConnStatus
ConnSndReady) Bool -> Bool -> Bool
&& Bool -> Bool
not (Connection -> Bool
connDisabled Connection
conn)) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
                (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
                  \Connection
db -> Connection
-> User
-> Maybe GroupMember
-> Connection
-> FileTransferMeta
-> FileDescr
-> IO ()
createSndFTDescrXFTP Connection
db User
user (GroupMember -> Maybe GroupMember
forall a. a -> Maybe a
Just GroupMember
m) Connection
conn FileTransferMeta
ft FileDescr
dummyFileDescr
            saveMemberFD GroupMember
_ = () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (FileInvitation, CIFile 'MDSnd)
-> CM (FileInvitation, CIFile 'MDSnd)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileInvitation
fInv, CIFile 'MDSnd
ciFile)
    prepareSndItemsData ::
      [ComposedMessageReq] ->
      [Maybe (CIFile 'MDSnd)] ->
      [Maybe (CIQuote c)] ->
      [Either ChatError SndMessage] ->
      [Either ChatError (NewSndChatItemData c)]
    prepareSndItemsData :: forall (c :: ChatType).
[ComposedMessageReq]
-> [Maybe (CIFile 'MDSnd)]
-> [Maybe (CIQuote c)]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData c)]
prepareSndItemsData =
      (ComposedMessageReq
 -> Maybe (CIFile 'MDSnd)
 -> Maybe (CIQuote c)
 -> Either ChatError SndMessage
 -> Either ChatError (NewSndChatItemData c))
-> [ComposedMessageReq]
-> [Maybe (CIFile 'MDSnd)]
-> [Maybe (CIQuote c)]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData c)]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 ((ComposedMessageReq
  -> Maybe (CIFile 'MDSnd)
  -> Maybe (CIQuote c)
  -> Either ChatError SndMessage
  -> Either ChatError (NewSndChatItemData c))
 -> [ComposedMessageReq]
 -> [Maybe (CIFile 'MDSnd)]
 -> [Maybe (CIQuote c)]
 -> [Either ChatError SndMessage]
 -> [Either ChatError (NewSndChatItemData c)])
-> (ComposedMessageReq
    -> Maybe (CIFile 'MDSnd)
    -> Maybe (CIQuote c)
    -> Either ChatError SndMessage
    -> Either ChatError (NewSndChatItemData c))
-> [ComposedMessageReq]
-> [Maybe (CIFile 'MDSnd)]
-> [Maybe (CIQuote c)]
-> [Either ChatError SndMessage]
-> [Either ChatError (NewSndChatItemData c)]
forall a b. (a -> b) -> a -> b
$ \(ComposedMessage {MsgContent
msgContent :: ComposedMessage -> MsgContent
msgContent :: MsgContent
msgContent}, Maybe CIForwardedFrom
itemForwarded, (Text, Maybe MarkdownList)
ts, Map Text CIMention
mm) Maybe (CIFile 'MDSnd)
f Maybe (CIQuote c)
q -> \case
        Right SndMessage
msg -> NewSndChatItemData c -> Either ChatError (NewSndChatItemData c)
forall a b. b -> Either a b
Right (NewSndChatItemData c -> Either ChatError (NewSndChatItemData c))
-> NewSndChatItemData c -> Either ChatError (NewSndChatItemData c)
forall a b. (a -> b) -> a -> b
$ SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
forall (c :: ChatType).
SndMessage
-> CIContent 'MDSnd
-> (Text, Maybe MarkdownList)
-> Map Text CIMention
-> Maybe (CIFile 'MDSnd)
-> Maybe (CIQuote c)
-> Maybe CIForwardedFrom
-> NewSndChatItemData c
NewSndChatItemData SndMessage
msg (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
msgContent) (Text, Maybe MarkdownList)
ts Map Text CIMention
mm Maybe (CIFile 'MDSnd)
f Maybe (CIQuote c)
q Maybe CIForwardedFrom
itemForwarded
        Left ChatError
e -> ChatError -> Either ChatError (NewSndChatItemData c)
forall a b. a -> Either a b
Left ChatError
e -- step over original error
    processSendErrs :: ([ChatError], [ChatItem c d]) -> CM ()
    processSendErrs :: forall (c :: ChatType) (d :: MsgDirection).
([ChatError], [ChatItem c d])
-> ExceptT ChatError (ReaderT ChatController IO) ()
processSendErrs = \case
      -- no errors
      ([], [ChatItem c d]
_) -> () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      -- at least one item is successfully created
      ([ChatError]
errs, ChatItem c d
_ci : [ChatItem c d]
_) -> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
      -- single error
      ([Item [ChatError]
err], []) -> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Item [ChatError]
ChatError
err
      -- multiple errors
      (errs :: [ChatError]
errs@(ChatError
err : [ChatError]
_), []) -> do
        ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
        ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a.
ChatError -> ExceptT ChatError (ReaderT ChatController IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChatError
err
    getCommandDirectChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (Contact, [CChatItem 'CTDirect])
    getCommandDirectChatItems :: User
-> Int64 -> NonEmpty Int64 -> CM (Contact, [CChatItem 'CTDirect])
getCommandDirectChatItems User
user Int64
ctId NonEmpty Int64
itemIds = do
      Contact
ct <- (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
ctId
      ([ChatError]
errs, [CChatItem 'CTDirect]
items) <- ReaderT ChatController IO ([ChatError], [CChatItem 'CTDirect])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [CChatItem 'CTDirect])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [CChatItem 'CTDirect])
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      ([ChatError], [CChatItem 'CTDirect]))
-> ReaderT ChatController IO ([ChatError], [CChatItem 'CTDirect])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [CChatItem 'CTDirect])
forall a b. (a -> b) -> a -> b
$ [Either ChatError (CChatItem 'CTDirect)]
-> ([ChatError], [CChatItem 'CTDirect])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError (CChatItem 'CTDirect)]
 -> ([ChatError], [CChatItem 'CTDirect]))
-> ReaderT
     ChatController IO [Either ChatError (CChatItem 'CTDirect)]
-> ReaderT ChatController IO ([ChatError], [CChatItem 'CTDirect])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO (Either ChatError (CChatItem 'CTDirect))])
-> ReaderT
     ChatController IO [Either ChatError (CChatItem 'CTDirect)]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO (Either ChatError a)))
-> CM' (t (Either ChatError a))
withStoreBatch (\Connection
db -> (Int64 -> IO (Either ChatError (CChatItem 'CTDirect)))
-> [Int64] -> [IO (Either ChatError (CChatItem 'CTDirect))]
forall a b. (a -> b) -> [a] -> [b]
map (Connection -> Int64 -> IO (Either ChatError (CChatItem 'CTDirect))
getDirectCI Connection
db) (NonEmpty Int64 -> [Int64]
forall a. NonEmpty a -> [a]
L.toList NonEmpty Int64
itemIds))
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
      (Contact, [CChatItem 'CTDirect])
-> CM (Contact, [CChatItem 'CTDirect])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Contact
ct, [CChatItem 'CTDirect]
items)
      where
        getDirectCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTDirect))
        getDirectCI :: Connection -> Int64 -> IO (Either ChatError (CChatItem 'CTDirect))
getDirectCI Connection
db Int64
itemId = ExceptT ChatError IO (CChatItem 'CTDirect)
-> IO (Either ChatError (CChatItem 'CTDirect))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError IO (CChatItem 'CTDirect)
 -> IO (Either ChatError (CChatItem 'CTDirect)))
-> (ExceptT StoreError IO (CChatItem 'CTDirect)
    -> ExceptT ChatError IO (CChatItem 'CTDirect))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
-> IO (Either ChatError (CChatItem 'CTDirect))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreError -> ChatError)
-> ExceptT StoreError IO (CChatItem 'CTDirect)
-> ExceptT ChatError IO (CChatItem 'CTDirect)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT StoreError -> ChatError
ChatErrorStore (ExceptT StoreError IO (CChatItem 'CTDirect)
 -> IO (Either ChatError (CChatItem 'CTDirect)))
-> ExceptT StoreError IO (CChatItem 'CTDirect)
-> IO (Either ChatError (CChatItem 'CTDirect))
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTDirect)
getDirectChatItem Connection
db User
user Int64
ctId Int64
itemId
    getCommandGroupChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (GroupInfo, [CChatItem 'CTGroup])
    getCommandGroupChatItems :: User
-> Int64 -> NonEmpty Int64 -> CM (GroupInfo, [CChatItem 'CTGroup])
getCommandGroupChatItems User
user Int64
gId NonEmpty Int64
itemIds = do
      GroupInfo
gInfo <- (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
gId
      ([ChatError]
errs, [CChatItem 'CTGroup]
items) <- ReaderT ChatController IO ([ChatError], [CChatItem 'CTGroup])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [CChatItem 'CTGroup])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [CChatItem 'CTGroup])
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      ([ChatError], [CChatItem 'CTGroup]))
-> ReaderT ChatController IO ([ChatError], [CChatItem 'CTGroup])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [CChatItem 'CTGroup])
forall a b. (a -> b) -> a -> b
$ [Either ChatError (CChatItem 'CTGroup)]
-> ([ChatError], [CChatItem 'CTGroup])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError (CChatItem 'CTGroup)]
 -> ([ChatError], [CChatItem 'CTGroup]))
-> ReaderT
     ChatController IO [Either ChatError (CChatItem 'CTGroup)]
-> ReaderT ChatController IO ([ChatError], [CChatItem 'CTGroup])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO (Either ChatError (CChatItem 'CTGroup))])
-> ReaderT
     ChatController IO [Either ChatError (CChatItem 'CTGroup)]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO (Either ChatError a)))
-> CM' (t (Either ChatError a))
withStoreBatch (\Connection
db -> (Int64 -> IO (Either ChatError (CChatItem 'CTGroup)))
-> [Int64] -> [IO (Either ChatError (CChatItem 'CTGroup))]
forall a b. (a -> b) -> [a] -> [b]
map (Connection
-> GroupInfo -> Int64 -> IO (Either ChatError (CChatItem 'CTGroup))
getGroupCI Connection
db GroupInfo
gInfo) (NonEmpty Int64 -> [Int64]
forall a. NonEmpty a -> [a]
L.toList NonEmpty Int64
itemIds))
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
      (GroupInfo, [CChatItem 'CTGroup])
-> CM (GroupInfo, [CChatItem 'CTGroup])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupInfo
gInfo, [CChatItem 'CTGroup]
items)
      where
        getGroupCI :: DB.Connection -> GroupInfo -> ChatItemId -> IO (Either ChatError (CChatItem 'CTGroup))
        getGroupCI :: Connection
-> GroupInfo -> Int64 -> IO (Either ChatError (CChatItem 'CTGroup))
getGroupCI Connection
db GroupInfo
gInfo Int64
itemId = ExceptT ChatError IO (CChatItem 'CTGroup)
-> IO (Either ChatError (CChatItem 'CTGroup))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError IO (CChatItem 'CTGroup)
 -> IO (Either ChatError (CChatItem 'CTGroup)))
-> (ExceptT StoreError IO (CChatItem 'CTGroup)
    -> ExceptT ChatError IO (CChatItem 'CTGroup))
-> ExceptT StoreError IO (CChatItem 'CTGroup)
-> IO (Either ChatError (CChatItem 'CTGroup))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreError -> ChatError)
-> ExceptT StoreError IO (CChatItem 'CTGroup)
-> ExceptT ChatError IO (CChatItem 'CTGroup)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT StoreError -> ChatError
ChatErrorStore (ExceptT StoreError IO (CChatItem 'CTGroup)
 -> IO (Either ChatError (CChatItem 'CTGroup)))
-> ExceptT StoreError IO (CChatItem 'CTGroup)
-> IO (Either ChatError (CChatItem 'CTGroup))
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> GroupInfo
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTGroup)
getGroupCIWithReactions Connection
db User
user GroupInfo
gInfo Int64
itemId
    getCommandLocalChatItems :: User -> Int64 -> NonEmpty ChatItemId -> CM (NoteFolder, [CChatItem 'CTLocal])
    getCommandLocalChatItems :: User
-> Int64 -> NonEmpty Int64 -> CM (NoteFolder, [CChatItem 'CTLocal])
getCommandLocalChatItems User
user Int64
nfId NonEmpty Int64
itemIds = do
      NoteFolder
nf <- (Connection -> ExceptT StoreError IO NoteFolder) -> CM NoteFolder
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO NoteFolder) -> CM NoteFolder)
-> (Connection -> ExceptT StoreError IO NoteFolder)
-> CM NoteFolder
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user Int64
nfId
      ([ChatError]
errs, [CChatItem 'CTLocal]
items) <- ReaderT ChatController IO ([ChatError], [CChatItem 'CTLocal])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [CChatItem 'CTLocal])
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO ([ChatError], [CChatItem 'CTLocal])
 -> ExceptT
      ChatError
      (ReaderT ChatController IO)
      ([ChatError], [CChatItem 'CTLocal]))
-> ReaderT ChatController IO ([ChatError], [CChatItem 'CTLocal])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     ([ChatError], [CChatItem 'CTLocal])
forall a b. (a -> b) -> a -> b
$ [Either ChatError (CChatItem 'CTLocal)]
-> ([ChatError], [CChatItem 'CTLocal])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ChatError (CChatItem 'CTLocal)]
 -> ([ChatError], [CChatItem 'CTLocal]))
-> ReaderT
     ChatController IO [Either ChatError (CChatItem 'CTLocal)]
-> ReaderT ChatController IO ([ChatError], [CChatItem 'CTLocal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> [IO (Either ChatError (CChatItem 'CTLocal))])
-> ReaderT
     ChatController IO [Either ChatError (CChatItem 'CTLocal)]
forall (t :: * -> *) a.
Traversable t =>
(Connection -> t (IO (Either ChatError a)))
-> CM' (t (Either ChatError a))
withStoreBatch (\Connection
db -> (Int64 -> IO (Either ChatError (CChatItem 'CTLocal)))
-> [Int64] -> [IO (Either ChatError (CChatItem 'CTLocal))]
forall a b. (a -> b) -> [a] -> [b]
map (Connection -> Int64 -> IO (Either ChatError (CChatItem 'CTLocal))
getLocalCI Connection
db) (NonEmpty Int64 -> [Int64]
forall a. NonEmpty a -> [a]
L.toList NonEmpty Int64
itemIds))
      Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ChatError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ChatError]
errs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
toView (ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ChatEvent -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ [ChatError] -> ChatEvent
CEvtChatErrors [ChatError]
errs
      (NoteFolder, [CChatItem 'CTLocal])
-> CM (NoteFolder, [CChatItem 'CTLocal])
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NoteFolder
nf, [CChatItem 'CTLocal]
items)
      where
        getLocalCI :: DB.Connection -> ChatItemId -> IO (Either ChatError (CChatItem 'CTLocal))
        getLocalCI :: Connection -> Int64 -> IO (Either ChatError (CChatItem 'CTLocal))
getLocalCI Connection
db Int64
itemId = ExceptT ChatError IO (CChatItem 'CTLocal)
-> IO (Either ChatError (CChatItem 'CTLocal))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ChatError IO (CChatItem 'CTLocal)
 -> IO (Either ChatError (CChatItem 'CTLocal)))
-> (ExceptT StoreError IO (CChatItem 'CTLocal)
    -> ExceptT ChatError IO (CChatItem 'CTLocal))
-> ExceptT StoreError IO (CChatItem 'CTLocal)
-> IO (Either ChatError (CChatItem 'CTLocal))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StoreError -> ChatError)
-> ExceptT StoreError IO (CChatItem 'CTLocal)
-> ExceptT ChatError IO (CChatItem 'CTLocal)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT StoreError -> ChatError
ChatErrorStore (ExceptT StoreError IO (CChatItem 'CTLocal)
 -> IO (Either ChatError (CChatItem 'CTLocal)))
-> ExceptT StoreError IO (CChatItem 'CTLocal)
-> IO (Either ChatError (CChatItem 'CTLocal))
forall a b. (a -> b) -> a -> b
$ Connection
-> User
-> Int64
-> Int64
-> ExceptT StoreError IO (CChatItem 'CTLocal)
getLocalChatItem Connection
db User
user Int64
nfId Int64
itemId
    forwardMsgContent :: ChatItem c d -> CM (Maybe MsgContent)
    forwardMsgContent :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CM (Maybe MsgContent)
forwardMsgContent ChatItem {meta :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIMeta c d
meta = CIMeta {itemDeleted :: forall (c :: ChatType) (d :: MsgDirection).
CIMeta c d -> Maybe (CIDeleted c)
itemDeleted = Just CIDeleted c
_}} = Maybe MsgContent -> CM (Maybe MsgContent)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe MsgContent
forall a. Maybe a
Nothing -- this can be deleted after selection
    forwardMsgContent ChatItem {content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CISndMsgContent MsgContent
fmc} = Maybe MsgContent -> CM (Maybe MsgContent)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe MsgContent -> CM (Maybe MsgContent))
-> Maybe MsgContent -> CM (Maybe MsgContent)
forall a b. (a -> b) -> a -> b
$ MsgContent -> Maybe MsgContent
forall a. a -> Maybe a
Just MsgContent
fmc
    forwardMsgContent ChatItem {content :: forall (c :: ChatType) (d :: MsgDirection).
ChatItem c d -> CIContent d
content = CIRcvMsgContent MsgContent
fmc} = Maybe MsgContent -> CM (Maybe MsgContent)
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe MsgContent -> CM (Maybe MsgContent))
-> Maybe MsgContent -> CM (Maybe MsgContent)
forall a b. (a -> b) -> a -> b
$ MsgContent -> Maybe MsgContent
forall a. a -> Maybe a
Just MsgContent
fmc
    forwardMsgContent ChatItem c d
_ = ChatErrorType -> CM (Maybe MsgContent)
forall a. ChatErrorType -> CM a
throwChatError ChatErrorType
CEInvalidForward
    createNoteFolderContentItems :: User -> NoteFolderId -> NonEmpty ComposedMessageReq -> CM ChatResponse
    createNoteFolderContentItems :: User -> Int64 -> NonEmpty ComposedMessageReq -> CM ChatResponse
createNoteFolderContentItems User
user Int64
folderId NonEmpty ComposedMessageReq
cmrs = do
      ExceptT ChatError (ReaderT ChatController IO) ()
assertNoQuotes
      NoteFolder
nf <- (Connection -> ExceptT StoreError IO NoteFolder) -> CM NoteFolder
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withFastStore ((Connection -> ExceptT StoreError IO NoteFolder) -> CM NoteFolder)
-> (Connection -> ExceptT StoreError IO NoteFolder)
-> CM NoteFolder
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> ExceptT StoreError IO NoteFolder
getNoteFolder Connection
db User
user Int64
folderId
      UTCTime
createdAt <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      NonEmpty (Maybe (CIFile 'MDSnd))
ciFiles_ <- NoteFolder -> UTCTime -> CM (NonEmpty (Maybe (CIFile 'MDSnd)))
createLocalFiles NoteFolder
nf UTCTime
createdAt
      let itemsData :: NonEmpty
  (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
   (Text, Maybe MarkdownList))
itemsData = NonEmpty ComposedMessageReq
-> NonEmpty (Maybe (CIFile 'MDSnd))
-> NonEmpty
     (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
      (Text, Maybe MarkdownList))
prepareLocalItemsData NonEmpty ComposedMessageReq
cmrs NonEmpty (Maybe (CIFile 'MDSnd))
ciFiles_
      [ChatItem 'CTLocal 'MDSnd]
cis <- User
-> ChatDirection 'CTLocal 'MDSnd
-> NonEmpty
     (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
      (Text, Maybe MarkdownList))
-> UTCTime
-> CM [ChatItem 'CTLocal 'MDSnd]
createLocalChatItems User
user (NoteFolder -> ChatDirection 'CTLocal 'MDSnd
CDLocalSnd NoteFolder
nf) NonEmpty
  (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
   (Text, Maybe MarkdownList))
itemsData UTCTime
createdAt
      ChatResponse -> CM ChatResponse
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatResponse -> CM ChatResponse)
-> ChatResponse -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ User -> [AChatItem] -> ChatResponse
CRNewChatItems User
user ((ChatItem 'CTLocal 'MDSnd -> AChatItem)
-> [ChatItem 'CTLocal 'MDSnd] -> [AChatItem]
forall a b. (a -> b) -> [a] -> [b]
map (SChatType 'CTLocal
-> SMsgDirection 'MDSnd
-> ChatInfo 'CTLocal
-> ChatItem 'CTLocal 'MDSnd
-> AChatItem
forall (c :: ChatType) (d :: MsgDirection).
(ChatTypeI c, MsgDirectionI d) =>
SChatType c
-> SMsgDirection d -> ChatInfo c -> ChatItem c d -> AChatItem
AChatItem SChatType 'CTLocal
SCTLocal SMsgDirection 'MDSnd
SMDSnd (NoteFolder -> ChatInfo 'CTLocal
LocalChat NoteFolder
nf)) [ChatItem 'CTLocal 'MDSnd]
cis)
      where
        assertNoQuotes :: CM ()
        assertNoQuotes :: ExceptT ChatError (ReaderT ChatController IO) ()
assertNoQuotes =
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ComposedMessageReq -> Bool) -> NonEmpty ComposedMessageReq -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(ComposedMessage {Maybe Int64
quotedItemId :: ComposedMessage -> Maybe Int64
quotedItemId :: Maybe Int64
quotedItemId}, Maybe CIForwardedFrom
_, (Text, Maybe MarkdownList)
_, Map Text CIMention
_) -> Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int64
quotedItemId) NonEmpty ComposedMessageReq
cmrs) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
            String -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. String -> CM a
throwCmdError String
"createNoteFolderContentItems: quotes not supported"
        createLocalFiles :: NoteFolder -> UTCTime -> CM (NonEmpty (Maybe (CIFile 'MDSnd)))
        createLocalFiles :: NoteFolder -> UTCTime -> CM (NonEmpty (Maybe (CIFile 'MDSnd)))
createLocalFiles NoteFolder
nf UTCTime
createdAt =
          NonEmpty ComposedMessageReq
-> (ComposedMessageReq
    -> ExceptT
         ChatError (ReaderT ChatController IO) (Maybe (CIFile 'MDSnd)))
-> CM (NonEmpty (Maybe (CIFile 'MDSnd)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty ComposedMessageReq
cmrs ((ComposedMessageReq
  -> ExceptT
       ChatError (ReaderT ChatController IO) (Maybe (CIFile 'MDSnd)))
 -> CM (NonEmpty (Maybe (CIFile 'MDSnd))))
-> (ComposedMessageReq
    -> ExceptT
         ChatError (ReaderT ChatController IO) (Maybe (CIFile 'MDSnd)))
-> CM (NonEmpty (Maybe (CIFile 'MDSnd)))
forall a b. (a -> b) -> a -> b
$ \(ComposedMessage {fileSource :: ComposedMessage -> Maybe CryptoFile
fileSource = Maybe CryptoFile
file_}, Maybe CIForwardedFrom
_, (Text, Maybe MarkdownList)
_, Map Text CIMention
_) ->
            Maybe CryptoFile
-> (CryptoFile
    -> ExceptT ChatError (ReaderT ChatController IO) (CIFile 'MDSnd))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe (CIFile 'MDSnd))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe CryptoFile
file_ ((CryptoFile
  -> ExceptT ChatError (ReaderT ChatController IO) (CIFile 'MDSnd))
 -> ExceptT
      ChatError (ReaderT ChatController IO) (Maybe (CIFile 'MDSnd)))
-> (CryptoFile
    -> ExceptT ChatError (ReaderT ChatController IO) (CIFile 'MDSnd))
-> ExceptT
     ChatError (ReaderT ChatController IO) (Maybe (CIFile 'MDSnd))
forall a b. (a -> b) -> a -> b
$ \cf :: CryptoFile
cf@CryptoFile {String
filePath :: CryptoFile -> String
filePath :: String
filePath, Maybe CryptoFileArgs
cryptoArgs :: CryptoFile -> Maybe CryptoFileArgs
cryptoArgs :: Maybe CryptoFileArgs
cryptoArgs} -> do
              String
fsFilePath <- ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT ChatController IO String
 -> ExceptT ChatError (ReaderT ChatController IO) String)
-> ReaderT ChatController IO String
-> ExceptT ChatError (ReaderT ChatController IO) String
forall a b. (a -> b) -> a -> b
$ String -> ReaderT ChatController IO String
toFSFilePath String
filePath
              Integer
fileSize <- IO Integer -> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer
 -> ExceptT ChatError (ReaderT ChatController IO) Integer)
-> IO Integer
-> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a b. (a -> b) -> a -> b
$ CryptoFile -> IO Integer
CF.getFileContentsSize (CryptoFile -> IO Integer) -> CryptoFile -> IO Integer
forall a b. (a -> b) -> a -> b
$ String -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile String
fsFilePath Maybe CryptoFileArgs
cryptoArgs
              Integer
chunkSize <- (ChatController -> Integer)
-> ExceptT ChatError (ReaderT ChatController IO) Integer
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ChatController -> Integer)
 -> ExceptT ChatError (ReaderT ChatController IO) Integer)
-> (ChatController -> Integer)
-> ExceptT ChatError (ReaderT ChatController IO) Integer
forall a b. (a -> b) -> a -> b
$ ChatConfig -> Integer
fileChunkSize (ChatConfig -> Integer)
-> (ChatController -> ChatConfig) -> ChatController -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> ChatConfig
config
              (Connection -> IO (CIFile 'MDSnd))
-> ExceptT ChatError (ReaderT ChatController IO) (CIFile 'MDSnd)
forall a. (Connection -> IO a) -> CM a
withFastStore' ((Connection -> IO (CIFile 'MDSnd))
 -> ExceptT ChatError (ReaderT ChatController IO) (CIFile 'MDSnd))
-> (Connection -> IO (CIFile 'MDSnd))
-> ExceptT ChatError (ReaderT ChatController IO) (CIFile 'MDSnd)
forall a b. (a -> b) -> a -> b
$ \Connection
db -> do
                Int64
fileId <- CIFileStatus 'MDSnd
-> Connection
-> User
-> NoteFolder
-> UTCTime
-> CryptoFile
-> Integer
-> Integer
-> IO Int64
forall (d :: MsgDirection).
ToField (CIFileStatus d) =>
CIFileStatus d
-> Connection
-> User
-> NoteFolder
-> UTCTime
-> CryptoFile
-> Integer
-> Integer
-> IO Int64
createLocalFile CIFileStatus 'MDSnd
CIFSSndStored Connection
db User
user NoteFolder
nf UTCTime
createdAt CryptoFile
cf Integer
fileSize Integer
chunkSize
                CIFile 'MDSnd -> IO (CIFile 'MDSnd)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CIFile {Int64
fileId :: Int64
fileId :: Int64
fileId, fileName :: String
fileName = String -> String
takeFileName String
filePath, Integer
fileSize :: Integer
fileSize :: Integer
fileSize, fileSource :: Maybe CryptoFile
fileSource = CryptoFile -> Maybe CryptoFile
forall a. a -> Maybe a
Just CryptoFile
cf, fileStatus :: CIFileStatus 'MDSnd
fileStatus = CIFileStatus 'MDSnd
CIFSSndStored, fileProtocol :: FileProtocol
fileProtocol = FileProtocol
FPLocal}
        prepareLocalItemsData ::
          NonEmpty ComposedMessageReq ->
          NonEmpty (Maybe (CIFile 'MDSnd)) ->
          NonEmpty (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList))
        prepareLocalItemsData :: NonEmpty ComposedMessageReq
-> NonEmpty (Maybe (CIFile 'MDSnd))
-> NonEmpty
     (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
      (Text, Maybe MarkdownList))
prepareLocalItemsData =
          (ComposedMessageReq
 -> Maybe (CIFile 'MDSnd)
 -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
     (Text, Maybe MarkdownList)))
-> NonEmpty ComposedMessageReq
-> NonEmpty (Maybe (CIFile 'MDSnd))
-> NonEmpty
     (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
      (Text, Maybe MarkdownList))
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
L.zipWith ((ComposedMessageReq
  -> Maybe (CIFile 'MDSnd)
  -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
      (Text, Maybe MarkdownList)))
 -> NonEmpty ComposedMessageReq
 -> NonEmpty (Maybe (CIFile 'MDSnd))
 -> NonEmpty
      (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
       (Text, Maybe MarkdownList)))
-> (ComposedMessageReq
    -> Maybe (CIFile 'MDSnd)
    -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
        (Text, Maybe MarkdownList)))
-> NonEmpty ComposedMessageReq
-> NonEmpty (Maybe (CIFile 'MDSnd))
-> NonEmpty
     (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom,
      (Text, Maybe MarkdownList))
forall a b. (a -> b) -> a -> b
$ \(ComposedMessage {msgContent :: ComposedMessage -> MsgContent
msgContent = MsgContent
mc}, Maybe CIForwardedFrom
itemForwarded, (Text, Maybe MarkdownList)
ts, Map Text CIMention
_) Maybe (CIFile 'MDSnd)
f ->
            (MsgContent -> CIContent 'MDSnd
CISndMsgContent MsgContent
mc, Maybe (CIFile 'MDSnd)
f, Maybe CIForwardedFrom
itemForwarded, (Text, Maybe MarkdownList)
ts)
    getConnQueueInfo :: User -> Connection -> CM ChatResponse
getConnQueueInfo User
user Connection {Int64
connId :: Connection -> Int64
connId :: Int64
connId, agentConnId :: Connection -> AgentConnId
agentConnId = AgentConnId ByteString
acId} = do
      Maybe RcvMsgInfo
msgInfo <- (Connection -> IO (Maybe RcvMsgInfo)) -> CM (Maybe RcvMsgInfo)
forall a. (Connection -> IO a) -> CM a
withFastStore' (Connection -> Int64 -> IO (Maybe RcvMsgInfo)
`getLastRcvMsgInfo` Int64
connId)
      User -> Maybe RcvMsgInfo -> ServerQueueInfo -> ChatResponse
CRQueueInfo User
user Maybe RcvMsgInfo
msgInfo (ServerQueueInfo -> ChatResponse)
-> ExceptT ChatError (ReaderT ChatController IO) ServerQueueInfo
-> CM ChatResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AgentClient -> ExceptT AgentErrorType IO ServerQueueInfo)
-> ExceptT ChatError (ReaderT ChatController IO) ServerQueueInfo
forall a. (AgentClient -> ExceptT AgentErrorType IO a) -> CM a
withAgent (\AgentClient
a -> AgentClient
-> NetworkRequestMode
-> ByteString
-> ExceptT AgentErrorType IO ServerQueueInfo
getConnectionQueueInfo AgentClient
a NetworkRequestMode
nm ByteString
acId)
    withSendRef :: ChatRef -> (SendRef -> CM ChatResponse) -> CM ChatResponse
    withSendRef :: ChatRef -> (SendRef -> CM ChatResponse) -> CM ChatResponse
withSendRef ChatRef
chatRef SendRef -> CM ChatResponse
a = case ChatRef
chatRef of
      ChatRef ChatType
CTDirect Int64
cId Maybe GroupChatScope
_ -> SendRef -> CM ChatResponse
a (SendRef -> CM ChatResponse) -> SendRef -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> SendRef
SRDirect Int64
cId
      ChatRef ChatType
CTGroup Int64
gId Maybe GroupChatScope
scope -> SendRef -> CM ChatResponse
a (SendRef -> CM ChatResponse) -> SendRef -> CM ChatResponse
forall a b. (a -> b) -> a -> b
$ Int64 -> Maybe GroupChatScope -> SendRef
SRGroup Int64
gId Maybe GroupChatScope
scope
      ChatRef
_ -> String -> CM ChatResponse
forall a. String -> CM a
throwCmdError String
"not supported"
    getSharedMsgId :: CM SharedMsgId
    getSharedMsgId :: ExceptT ChatError (ReaderT ChatController IO) SharedMsgId
getSharedMsgId = do
      TVar ChaChaDRG
gVar <- (ChatController -> TVar ChaChaDRG)
-> ExceptT ChatError (ReaderT ChatController IO) (TVar ChaChaDRG)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TVar ChaChaDRG
random
      IO SharedMsgId
-> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SharedMsgId
 -> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId)
-> IO SharedMsgId
-> ExceptT ChatError (ReaderT ChatController IO) SharedMsgId
forall a b. (a -> b) -> a -> b
$ ByteString -> SharedMsgId
SharedMsgId (ByteString -> SharedMsgId) -> IO ByteString -> IO SharedMsgId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar ChaChaDRG -> Int -> IO ByteString
encodedRandomBytes TVar ChaChaDRG
gVar Int
12

data ConnectViaContactResult
  = CVRConnectedContact Contact
  | CVRSentInvitation Connection (Maybe Profile)

protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
protocolServers :: forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
-> ([Maybe ServerOperator], [UserServer 'PSMP],
    [UserServer 'PXFTP])
protocolServers SProtocolType p
p ([Maybe ServerOperator]
operators, [UserServer 'PSMP]
smpServers, [UserServer 'PXFTP]
xftpServers) = case SProtocolType p
p of
  SProtocolType p
SPSMP -> ([Maybe ServerOperator]
operators, [UserServer 'PSMP]
smpServers, [])
  SProtocolType p
SPXFTP -> ([Maybe ServerOperator]
operators, [], [UserServer 'PXFTP]
xftpServers)

-- disable preset and replace custom servers (groupByOperator always adds custom)
updatedServers :: forall p. UserProtocol p => SProtocolType p -> [AUserServer p] -> UserOperatorServers -> UpdatedUserOperatorServers
updatedServers :: forall (p :: ProtocolType).
UserProtocol p =>
SProtocolType p
-> [AUserServer p]
-> UserOperatorServers
-> UpdatedUserOperatorServers
updatedServers SProtocolType p
p' [AUserServer p]
srvs UserOperatorServers {Maybe ServerOperator
operator :: UserOperatorServers -> Maybe ServerOperator
operator :: Maybe ServerOperator
operator, [UserServer 'PSMP]
smpServers :: UserOperatorServers -> [UserServer 'PSMP]
smpServers :: [UserServer 'PSMP]
smpServers, [UserServer 'PXFTP]
xftpServers :: UserOperatorServers -> [UserServer 'PXFTP]
xftpServers :: [UserServer 'PXFTP]
xftpServers} = case SProtocolType p
p' of
  SProtocolType p
SPSMP -> ([AUserServer 'PSMP], [AUserServer 'PXFTP])
-> UpdatedUserOperatorServers
u ([UserServer p] -> [AUserServer p]
updateSrvs [UserServer p]
[UserServer 'PSMP]
smpServers, (UserServer 'PXFTP -> AUserServer 'PXFTP)
-> [UserServer 'PXFTP] -> [AUserServer 'PXFTP]
forall a b. (a -> b) -> [a] -> [b]
map (SDBStored 'DBStored -> UserServer 'PXFTP -> AUserServer 'PXFTP
forall (p :: ProtocolType) (s :: DBStored).
SDBStored s -> UserServer' s p -> AUserServer p
AUS SDBStored 'DBStored
SDBStored) [UserServer 'PXFTP]
xftpServers)
  SProtocolType p
SPXFTP -> ([AUserServer 'PSMP], [AUserServer 'PXFTP])
-> UpdatedUserOperatorServers
u ((UserServer 'PSMP -> AUserServer 'PSMP)
-> [UserServer 'PSMP] -> [AUserServer 'PSMP]
forall a b. (a -> b) -> [a] -> [b]
map (SDBStored 'DBStored -> UserServer 'PSMP -> AUserServer 'PSMP
forall (p :: ProtocolType) (s :: DBStored).
SDBStored s -> UserServer' s p -> AUserServer p
AUS SDBStored 'DBStored
SDBStored) [UserServer 'PSMP]
smpServers, [UserServer p] -> [AUserServer p]
updateSrvs [UserServer p]
[UserServer 'PXFTP]
xftpServers)
  where
    u :: ([AUserServer 'PSMP], [AUserServer 'PXFTP])
-> UpdatedUserOperatorServers
u = ([AUserServer 'PSMP]
 -> [AUserServer 'PXFTP] -> UpdatedUserOperatorServers)
-> ([AUserServer 'PSMP], [AUserServer 'PXFTP])
-> UpdatedUserOperatorServers
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([AUserServer 'PSMP]
  -> [AUserServer 'PXFTP] -> UpdatedUserOperatorServers)
 -> ([AUserServer 'PSMP], [AUserServer 'PXFTP])
 -> UpdatedUserOperatorServers)
-> ([AUserServer 'PSMP]
    -> [AUserServer 'PXFTP] -> UpdatedUserOperatorServers)
-> ([AUserServer 'PSMP], [AUserServer 'PXFTP])
-> UpdatedUserOperatorServers
forall a b. (a -> b) -> a -> b
$ Maybe ServerOperator
-> [AUserServer 'PSMP]
-> [AUserServer 'PXFTP]
-> UpdatedUserOperatorServers
UpdatedUserOperatorServers Maybe ServerOperator
operator
    updateSrvs :: [UserServer p] -> [AUserServer p]
    updateSrvs :: [UserServer p] -> [AUserServer p]
updateSrvs [UserServer p]
pSrvs = (UserServer p -> AUserServer p)
-> [UserServer p] -> [AUserServer p]
forall a b. (a -> b) -> [a] -> [b]
map UserServer p -> AUserServer p
forall {p :: ProtocolType}.
UserServer' 'DBStored p -> AUserServer p
disableSrv [UserServer p]
pSrvs [AUserServer p] -> [AUserServer p] -> [AUserServer p]
forall a. Semigroup a => a -> a -> a
<> [AUserServer p]
-> (ServerOperator -> [AUserServer p])
-> Maybe ServerOperator
-> [AUserServer p]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [AUserServer p]
srvs ([AUserServer p] -> ServerOperator -> [AUserServer p]
forall a b. a -> b -> a
const []) Maybe ServerOperator
operator
    disableSrv :: UserServer' 'DBStored p -> AUserServer p
disableSrv srv :: UserServer' 'DBStored p
srv@UserServer {Bool
preset :: Bool
preset :: forall (s :: DBStored) (p :: ProtocolType). UserServer' s p -> Bool
preset} =
      SDBStored 'DBStored -> UserServer' 'DBStored p -> AUserServer p
forall (p :: ProtocolType) (s :: DBStored).
SDBStored s -> UserServer' s p -> AUserServer p
AUS SDBStored 'DBStored
SDBStored (UserServer' 'DBStored p -> AUserServer p)
-> UserServer' 'DBStored p -> AUserServer p
forall a b. (a -> b) -> a -> b
$ if Bool
preset then UserServer' 'DBStored p
srv {enabled = False} else UserServer' 'DBStored p
srv {deleted = True}

type ComposedMessageReq = (ComposedMessage, Maybe CIForwardedFrom, (Text, Maybe MarkdownList), Map MemberName CIMention)

composedMessage :: Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage :: Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage Maybe CryptoFile
f MsgContent
mc = ComposedMessage {fileSource :: Maybe CryptoFile
fileSource = Maybe CryptoFile
f, quotedItemId :: Maybe Int64
quotedItemId = Maybe Int64
forall a. Maybe a
Nothing, msgContent :: MsgContent
msgContent = MsgContent
mc, mentions :: Map Text Int64
mentions = Map Text Int64
forall k a. Map k a
M.empty}

composedMessageReq :: ComposedMessage -> ComposedMessageReq
composedMessageReq :: ComposedMessage -> ComposedMessageReq
composedMessageReq cm :: ComposedMessage
cm@ComposedMessage {msgContent :: ComposedMessage -> MsgContent
msgContent = MsgContent
mc} = (ComposedMessage
cm, Maybe CIForwardedFrom
forall a. Maybe a
Nothing, MsgContent -> (Text, Maybe MarkdownList)
msgContentTexts MsgContent
mc, Map Text CIMention
forall k a. Map k a
M.empty)

composedMessageReqMentions :: DB.Connection -> User -> GroupInfo -> ComposedMessage -> ExceptT StoreError IO ComposedMessageReq
composedMessageReqMentions :: Connection
-> User
-> GroupInfo
-> ComposedMessage
-> ExceptT StoreError IO ComposedMessageReq
composedMessageReqMentions Connection
db User
user GroupInfo
g cm :: ComposedMessage
cm@ComposedMessage {msgContent :: ComposedMessage -> MsgContent
msgContent = MsgContent
mc, Map Text Int64
mentions :: ComposedMessage -> Map Text Int64
mentions :: Map Text Int64
mentions} = do
  let ts :: (Text, Maybe MarkdownList)
ts@(Text
_, Maybe MarkdownList
ft_) = MsgContent -> (Text, Maybe MarkdownList)
msgContentTexts MsgContent
mc
  (ComposedMessage
cm,Maybe CIForwardedFrom
forall a. Maybe a
Nothing,(Text, Maybe MarkdownList)
ts,) (Map Text CIMention -> ComposedMessageReq)
-> ExceptT StoreError IO (Map Text CIMention)
-> ExceptT StoreError IO ComposedMessageReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> User
-> GroupInfo
-> Maybe MarkdownList
-> Map Text Int64
-> ExceptT StoreError IO (Map Text CIMention)
getCIMentions Connection
db User
user GroupInfo
g Maybe MarkdownList
ft_ Map Text Int64
mentions

data ChangedProfileContact = ChangedProfileContact
  { ChangedProfileContact -> Contact
ct :: Contact,
    ChangedProfileContact -> Contact
ct' :: Contact,
    ChangedProfileContact -> Profile
mergedProfile' :: Profile,
    ChangedProfileContact -> Connection
conn :: Connection
  }

createContactsSndFeatureItems :: User -> [ChangedProfileContact] -> CM' ()
createContactsSndFeatureItems :: User -> [ChangedProfileContact] -> ReaderT ChatController IO ()
createContactsSndFeatureItems User
user [ChangedProfileContact]
cts =
  User
-> [(Contact, Contact)]
-> (Contact -> ChatDirection 'CTDirect 'MDSnd)
-> FeatureContent PrefEnabled 'MDSnd
-> FeatureContent FeatureAllowed 'MDSnd
-> (forall (f :: ChatFeature).
    ContactUserPreference (FeaturePreference f) -> FeaturePreference f)
-> ReaderT ChatController IO ()
forall (d :: MsgDirection).
MsgDirectionI d =>
User
-> [(Contact, Contact)]
-> (Contact -> ChatDirection 'CTDirect d)
-> FeatureContent PrefEnabled d
-> FeatureContent FeatureAllowed d
-> (forall (f :: ChatFeature).
    ContactUserPreference (FeaturePreference f) -> FeaturePreference f)
-> ReaderT ChatController IO ()
createContactsFeatureItems User
user [(Contact, Contact)]
cts' Contact -> ChatDirection 'CTDirect 'MDSnd
CDDirectSnd FeatureContent PrefEnabled 'MDSnd
CISndChatFeature FeatureContent FeatureAllowed 'MDSnd
CISndChatPreference ContactUserPreference (FeaturePreference f) -> FeaturePreference f
forall {p}. ContactUserPreference p -> p
forall (f :: ChatFeature).
ContactUserPreference (FeaturePreference f) -> FeaturePreference f
getPref
  where
    cts' :: [(Contact, Contact)]
cts' = (ChangedProfileContact -> (Contact, Contact))
-> [ChangedProfileContact] -> [(Contact, Contact)]
forall a b. (a -> b) -> [a] -> [b]
map (\ChangedProfileContact {Contact
ct :: ChangedProfileContact -> Contact
ct :: Contact
ct, Contact
ct' :: ChangedProfileContact -> Contact
ct' :: Contact
ct'} -> (Contact
ct, Contact
ct')) [ChangedProfileContact]
cts
    getPref :: ContactUserPreference p -> p
getPref ContactUserPreference {ContactUserPref p
userPreference :: ContactUserPref p
userPreference :: forall p. ContactUserPreference p -> ContactUserPref p
userPreference} = case ContactUserPref p
userPreference of
      CUPContact {p
preference :: p
preference :: forall p. ContactUserPref p -> p
preference} -> p
preference
      CUPUser {p
preference :: forall p. ContactUserPref p -> p
preference :: p
preference} -> p
preference

assertDirectAllowed :: User -> MsgDirection -> Contact -> CMEventTag e -> CM ()
assertDirectAllowed :: forall (e :: MsgEncoding).
User
-> MsgDirection
-> Contact
-> CMEventTag e
-> ExceptT ChatError (ReaderT ChatController IO) ()
assertDirectAllowed User
user MsgDirection
dir Contact
ct CMEventTag e
event =
  Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
allowedChatEvent Bool -> Bool -> Bool
|| Contact -> Bool
anyDirectOrUsed Contact
ct) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ExceptT ChatError (ReaderT ChatController IO) ()
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT ChatError (ReaderT ChatController IO) Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM ExceptT ChatError (ReaderT ChatController IO) Bool
directMessagesAllowed (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$
    ChatErrorType -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. ChatErrorType -> CM a
throwChatError (MsgDirection -> Contact -> ChatErrorType
CEDirectMessagesProhibited MsgDirection
dir Contact
ct)
  where
    directMessagesAllowed :: ExceptT ChatError (ReaderT ChatController IO) Bool
directMessagesAllowed = ((GroupMemberRole, FullGroupPreferences) -> Bool)
-> [(GroupMemberRole, FullGroupPreferences)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((GroupMemberRole -> FullGroupPreferences -> Bool)
-> (GroupMemberRole, FullGroupPreferences) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((GroupMemberRole -> FullGroupPreferences -> Bool)
 -> (GroupMemberRole, FullGroupPreferences) -> Bool)
-> (GroupMemberRole -> FullGroupPreferences -> Bool)
-> (GroupMemberRole, FullGroupPreferences)
-> Bool
forall a b. (a -> b) -> a -> b
$ SGroupFeature 'GFDirectMessages
-> GroupMemberRole -> FullGroupPreferences -> Bool
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> GroupMemberRole -> FullGroupPreferences -> Bool
groupFeatureMemberAllowed' SGroupFeature 'GFDirectMessages
SGFDirectMessages) ([(GroupMemberRole, FullGroupPreferences)] -> Bool)
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [(GroupMemberRole, FullGroupPreferences)]
-> ExceptT ChatError (ReaderT ChatController IO) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> IO [(GroupMemberRole, FullGroupPreferences)])
-> ExceptT
     ChatError
     (ReaderT ChatController IO)
     [(GroupMemberRole, FullGroupPreferences)]
forall a. (Connection -> IO a) -> CM a
withStore' (\Connection
db -> Connection
-> User -> Contact -> IO [(GroupMemberRole, FullGroupPreferences)]
getContactGroupPreferences Connection
db User
user Contact
ct)
    allowedChatEvent :: Bool
allowedChatEvent = case CMEventTag e
event of
      CMEventTag e
XMsgNew_ -> Bool
False
      CMEventTag e
XMsgUpdate_ -> Bool
False
      CMEventTag e
XMsgDel_ -> Bool
False
      CMEventTag e
XFile_ -> Bool
False
      CMEventTag e
XGrpInv_ -> Bool
False
      CMEventTag e
XCallInv_ -> Bool
False
      CMEventTag e
_ -> Bool
True

startExpireCIThread :: User -> CM' ()
startExpireCIThread :: User -> ReaderT ChatController IO ()
startExpireCIThread user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} = do
  TMap Int64 (Maybe (Async ()))
expireThreads <- (ChatController -> TMap Int64 (Maybe (Async ())))
-> ReaderT ChatController IO (TMap Int64 (Maybe (Async ())))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 (Maybe (Async ()))
expireCIThreads
  STM (Maybe (Maybe (Async ())))
-> ReaderT ChatController IO (Maybe (Maybe (Async ())))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (Int64
-> TMap Int64 (Maybe (Async ())) -> STM (Maybe (Maybe (Async ())))
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookup Int64
userId TMap Int64 (Maybe (Async ()))
expireThreads) ReaderT ChatController IO (Maybe (Maybe (Async ())))
-> (Maybe (Maybe (Async ())) -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Maybe (Async ()))
Nothing -> do
      Maybe (Async ())
a <- Async () -> Maybe (Async ())
forall a. a -> Maybe a
Just (Async () -> Maybe (Async ()))
-> CM' (Async ()) -> ReaderT ChatController IO (Maybe (Async ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ChatController IO () -> CM' (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async ReaderT ChatController IO ()
runExpireCIs
      STM () -> ReaderT ChatController IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ReaderT ChatController IO ())
-> STM () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ Int64
-> Maybe (Async ()) -> TMap Int64 (Maybe (Async ())) -> STM ()
forall k a. Ord k => k -> a -> TMap k a -> STM ()
TM.insert Int64
userId Maybe (Async ())
a TMap Int64 (Maybe (Async ()))
expireThreads
    Maybe (Maybe (Async ()))
_ -> () -> ReaderT ChatController IO ()
forall a. a -> ReaderT ChatController IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    runExpireCIs :: ReaderT ChatController IO ()
runExpireCIs = do
      Int64
delay <- (ChatController -> Int64) -> ReaderT ChatController IO Int64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ChatConfig -> Int64
initialCleanupManagerDelay (ChatConfig -> Int64)
-> (ChatController -> ChatConfig) -> ChatController -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> ChatConfig
config)
      IO () -> ReaderT ChatController IO ()
forall a. IO a -> ReaderT ChatController IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ChatController IO ())
-> IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> IO ()
threadDelay' Int64
delay
      Int64
interval <- (ChatController -> Int64) -> ReaderT ChatController IO Int64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ChatController -> Int64) -> ReaderT ChatController IO Int64)
-> (ChatController -> Int64) -> ReaderT ChatController IO Int64
forall a b. (a -> b) -> a -> b
$ ChatConfig -> Int64
ciExpirationInterval (ChatConfig -> Int64)
-> (ChatController -> ChatConfig) -> ChatController -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> ChatConfig
config
      ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ do
        (ExceptT ChatError (ReaderT ChatController IO) ()
 -> (ChatError -> ReaderT ChatController IO ())
 -> ReaderT ChatController IO ())
-> (ChatError -> ReaderT ChatController IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> m a) -> m a
catchAllErrors' (ChatError -> ReaderT ChatController IO ()
eToView') (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ReaderT ChatController IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ do
          TMap Int64 Bool
expireFlags <- (ChatController -> TMap Int64 Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (TMap Int64 Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Bool
expireCIFlags
          STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> STM () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> TMap Int64 Bool -> STM (Maybe Bool)
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookup Int64
userId TMap Int64 Bool
expireFlags STM (Maybe Bool) -> (Maybe Bool -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Bool
b -> Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Bool
b Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) STM ()
forall a. STM a
retry
          ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO ()
waitChatStartedAndActivated
          Int64
ttl <- (Connection -> IO Int64) -> CM Int64
forall a. (Connection -> IO a) -> CM a
withStore' (Connection -> User -> IO Int64
`getChatItemTTL` User
user)
          User
-> Int64
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireChatItems User
user Int64
ttl Bool
False
        IO () -> ReaderT ChatController IO ()
forall a. IO a -> ReaderT ChatController IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT ChatController IO ())
-> IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> IO ()
threadDelay' Int64
interval

setChatItemsExpiration :: User -> Int64 -> Int -> CM' ()
setChatItemsExpiration :: User -> Int64 -> Int -> ReaderT ChatController IO ()
setChatItemsExpiration User
user Int64
newTTL Int
ttlCount
  | Int64
newTTL Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
|| Int
ttlCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
      User -> ReaderT ChatController IO ()
startExpireCIThread User
user
      ReaderT ChatController IO Bool
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ReaderT ChatController IO Bool
chatStarted (ReaderT ChatController IO () -> ReaderT ChatController IO ())
-> ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ User -> Bool -> ReaderT ChatController IO ()
setExpireCIFlag User
user Bool
True
  | Bool
otherwise = User -> Bool -> ReaderT ChatController IO ()
setExpireCIFlag User
user Bool
False

setExpireCIFlag :: User -> Bool -> CM' ()
setExpireCIFlag :: User -> Bool -> ReaderT ChatController IO ()
setExpireCIFlag User {Int64
userId :: User -> Int64
userId :: Int64
userId} Bool
b = do
  TMap Int64 Bool
expireFlags <- (ChatController -> TMap Int64 Bool)
-> ReaderT ChatController IO (TMap Int64 Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Bool
expireCIFlags
  STM () -> ReaderT ChatController IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ReaderT ChatController IO ())
-> STM () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Bool -> TMap Int64 Bool -> STM ()
forall k a. Ord k => k -> a -> TMap k a -> STM ()
TM.insert Int64
userId Bool
b TMap Int64 Bool
expireFlags

setAllExpireCIFlags :: Bool -> CM' ()
setAllExpireCIFlags :: Bool -> ReaderT ChatController IO ()
setAllExpireCIFlags Bool
b = do
  TMap Int64 Bool
expireFlags <- (ChatController -> TMap Int64 Bool)
-> ReaderT ChatController IO (TMap Int64 Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Bool
expireCIFlags
  STM () -> ReaderT ChatController IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> ReaderT ChatController IO ())
-> STM () -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ do
    [Int64]
keys <- Map Int64 Bool -> [Int64]
forall k a. Map k a -> [k]
M.keys (Map Int64 Bool -> [Int64]) -> STM (Map Int64 Bool) -> STM [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMap Int64 Bool -> STM (Map Int64 Bool)
forall a. TVar a -> STM a
readTVar TMap Int64 Bool
expireFlags
    [Int64] -> (Int64 -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int64]
keys ((Int64 -> STM ()) -> STM ()) -> (Int64 -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Int64
k -> Int64 -> Bool -> TMap Int64 Bool -> STM ()
forall k a. Ord k => k -> a -> TMap k a -> STM ()
TM.insert Int64
k Bool
b TMap Int64 Bool
expireFlags

agentSubscriber :: CM' ()
agentSubscriber :: ReaderT ChatController IO ()
agentSubscriber = do
  TBQueue ATransmission
q <- (ChatController -> TBQueue ATransmission)
-> ReaderT ChatController IO (TBQueue ATransmission)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((ChatController -> TBQueue ATransmission)
 -> ReaderT ChatController IO (TBQueue ATransmission))
-> (ChatController -> TBQueue ATransmission)
-> ReaderT ChatController IO (TBQueue ATransmission)
forall a b. (a -> b) -> a -> b
$ AgentClient -> TBQueue ATransmission
subQ (AgentClient -> TBQueue ATransmission)
-> (ChatController -> AgentClient)
-> ChatController
-> TBQueue ATransmission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> AgentClient
smpAgent
  ReaderT ChatController IO () -> ReaderT ChatController IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (STM ATransmission -> ReaderT ChatController IO ATransmission
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TBQueue ATransmission -> STM ATransmission
forall a. TBQueue a -> STM a
readTBQueue TBQueue ATransmission
q) ReaderT ChatController IO ATransmission
-> (ATransmission -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall a b.
ReaderT ChatController IO a
-> (a -> ReaderT ChatController IO b)
-> ReaderT ChatController IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ATransmission -> ReaderT ChatController IO ()
process)
    ReaderT ChatController IO ()
-> (SomeException -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`E.catchAny` \SomeException
e -> do
      ChatError -> ReaderT ChatController IO ()
eToView' (ChatError -> ReaderT ChatController IO ())
-> ChatError -> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ AgentErrorType
-> AgentConnId -> Maybe ConnectionEntity -> ChatError
ChatErrorAgent (Bool -> String -> AgentErrorType
CRITICAL Bool
True (String -> AgentErrorType) -> String -> AgentErrorType
forall a b. (a -> b) -> a -> b
$ String
"Message reception stopped: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall a. Show a => a -> String
show SomeException
e) (ByteString -> AgentConnId
AgentConnId ByteString
"") Maybe ConnectionEntity
forall a. Maybe a
Nothing
      SomeException -> ReaderT ChatController IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO SomeException
e
  where
    process :: (ACorrId, AEntityId, AEvt) -> CM' ()
    process :: ATransmission -> ReaderT ChatController IO ()
process (ByteString
corrId, ByteString
entId, AEvt SAEntity e
e AEvent e
msg) = ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO ()
run (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ReaderT ChatController IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO ()
forall a b. (a -> b) -> a -> b
$ case SAEntity e
e of
      SAEntity e
SAENone -> AEvent 'AENone -> ExceptT ChatError (ReaderT ChatController IO) ()
processAgentMessageNoConn AEvent e
AEvent 'AENone
msg
      SAEntity e
SAEConn -> ByteString
-> ByteString
-> AEvent 'AEConn
-> ExceptT ChatError (ReaderT ChatController IO) ()
processAgentMessage ByteString
corrId ByteString
entId AEvent e
AEvent 'AEConn
msg
      SAEntity e
SAERcvFile -> ByteString
-> ByteString
-> AEvent 'AERcvFile
-> ExceptT ChatError (ReaderT ChatController IO) ()
processAgentMsgRcvFile ByteString
corrId ByteString
entId AEvent e
AEvent 'AERcvFile
msg
      SAEntity e
SAESndFile -> ByteString
-> ByteString
-> AEvent 'AESndFile
-> ExceptT ChatError (ReaderT ChatController IO) ()
processAgentMsgSndFile ByteString
corrId ByteString
entId AEvent e
AEvent 'AESndFile
msg
      where
        run :: ExceptT ChatError (ReaderT ChatController IO) ()
-> ReaderT ChatController IO ()
run ExceptT ChatError (ReaderT ChatController IO) ()
action = ExceptT ChatError (ReaderT ChatController IO) ()
action ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ReaderT ChatController IO ())
-> ReaderT ChatController IO ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> m a) -> m a
`catchAllErrors'` (ChatError -> ReaderT ChatController IO ()
eToView')

type AgentSubResult = Map ConnId (Either AgentErrorType (Maybe ClientServiceId))

cleanupManager :: CM ()
cleanupManager :: ExceptT ChatError (ReaderT ChatController IO) ()
cleanupManager = do
  NominalDiffTime
interval <- (ChatController -> NominalDiffTime)
-> ExceptT ChatError (ReaderT ChatController IO) NominalDiffTime
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ChatConfig -> NominalDiffTime
cleanupManagerInterval (ChatConfig -> NominalDiffTime)
-> (ChatController -> ChatConfig)
-> ChatController
-> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> ChatConfig
config)
  NominalDiffTime -> ExceptT ChatError (ReaderT ChatController IO) ()
runWithoutInitialDelay NominalDiffTime
interval
  Int64
initialDelay <- (ChatController -> Int64) -> CM Int64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ChatConfig -> Int64
initialCleanupManagerDelay (ChatConfig -> Int64)
-> (ChatController -> ChatConfig) -> ChatController -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> ChatConfig
config)
  IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> IO ()
threadDelay' Int64
initialDelay
  Int64
stepDelay <- (ChatController -> Int64) -> CM Int64
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (ChatConfig -> Int64
cleanupManagerStepDelay (ChatConfig -> Int64)
-> (ChatController -> ChatConfig) -> ChatController -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatController -> ChatConfig
config)
  ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
    (ExceptT ChatError (ReaderT ChatController IO) ()
 -> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllErrors ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
      ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO ()
waitChatStartedAndActivated
      [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withStore' Connection -> IO [User]
getUsers
      let ([User]
us, [User]
us') = (User -> Bool) -> [User] -> ([User], [User])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition User -> Bool
activeUser [User]
users
      [User]
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [User]
us ((User -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
-> Int64
-> User
-> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupUser NominalDiffTime
interval Int64
stepDelay
      [User]
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [User]
us' ((User -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
-> Int64
-> User
-> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupUser NominalDiffTime
interval Int64
stepDelay
      ExceptT ChatError (ReaderT ChatController IO) ()
cleanupMessages ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      ExceptT ChatError (ReaderT ChatController IO) ()
cleanupDeliveryTasks ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      ExceptT ChatError (ReaderT ChatController IO) ()
cleanupDeliveryJobs ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      -- TODO possibly, also cleanup async commands
      ExceptT ChatError (ReaderT ChatController IO) ()
cleanupProbes ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
    IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> IO ()
threadDelay' (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Int64
diffToMicroseconds NominalDiffTime
interval
  where
    runWithoutInitialDelay :: NominalDiffTime -> ExceptT ChatError (ReaderT ChatController IO) ()
runWithoutInitialDelay NominalDiffTime
cleanupInterval = (ExceptT ChatError (ReaderT ChatController IO) ()
 -> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catchAllErrors ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
      ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO ()
waitChatStartedAndActivated
      [User]
users <- (Connection -> IO [User])
-> ExceptT ChatError (ReaderT ChatController IO) [User]
forall a. (Connection -> IO a) -> CM a
withStore' Connection -> IO [User]
getUsers
      let ([User]
us, [User]
us') = (User -> Bool) -> [User] -> ([User], [User])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition User -> Bool
activeUser [User]
users
      [User]
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [User]
us ((User -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \User
u -> NominalDiffTime
-> User -> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupTimedItems NominalDiffTime
cleanupInterval User
u ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      [User]
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [User]
us' ((User -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (User -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \User
u -> NominalDiffTime
-> User -> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupTimedItems NominalDiffTime
cleanupInterval User
u ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
    cleanupUser :: NominalDiffTime
-> Int64
-> User
-> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupUser NominalDiffTime
cleanupInterval Int64
stepDelay User
user = do
      NominalDiffTime
-> User -> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupTimedItems NominalDiffTime
cleanupInterval User
user ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> IO ()
threadDelay' Int64
stepDelay
      -- TODO remove in future versions: legacy step - contacts are no longer marked as deleted
      User -> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupDeletedContacts User
user ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ChatError (ReaderT ChatController IO) ())
-> IO () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int64 -> IO ()
threadDelay' Int64
stepDelay
    cleanupTimedItems :: NominalDiffTime
-> User -> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupTimedItems NominalDiffTime
cleanupInterval User
user = do
      UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let startTimedThreadCutoff :: UTCTime
startTimedThreadCutoff = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
cleanupInterval UTCTime
ts
      [((ChatRef, Int64), UTCTime)]
timedItems <- (Connection -> IO [((ChatRef, Int64), UTCTime)])
-> CM [((ChatRef, Int64), UTCTime)]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [((ChatRef, Int64), UTCTime)])
 -> CM [((ChatRef, Int64), UTCTime)])
-> (Connection -> IO [((ChatRef, Int64), UTCTime)])
-> CM [((ChatRef, Int64), UTCTime)]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> UTCTime -> IO [((ChatRef, Int64), UTCTime)]
getTimedItems Connection
db User
user UTCTime
startTimedThreadCutoff
      [((ChatRef, Int64), UTCTime)]
-> (((ChatRef, Int64), UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [((ChatRef, Int64), UTCTime)]
timedItems ((((ChatRef, Int64), UTCTime)
  -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (((ChatRef, Int64), UTCTime)
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \((ChatRef, Int64)
itemRef, UTCTime
deleteAt) -> User
-> (ChatRef, Int64)
-> UTCTime
-> ExceptT ChatError (ReaderT ChatController IO) ()
startTimedItemThread User
user (ChatRef, Int64)
itemRef UTCTime
deleteAt ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ExceptT ChatError (ReaderT ChatController IO) ()
-> ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. a -> b -> a
const (() -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    cleanupDeletedContacts :: User -> ExceptT ChatError (ReaderT ChatController IO) ()
cleanupDeletedContacts User
user = do
      VersionRangeChat
vr <- CM VersionRangeChat
chatVersionRange
      [Contact]
contacts <- (Connection -> IO [Contact])
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [Contact])
 -> ExceptT ChatError (ReaderT ChatController IO) [Contact])
-> (Connection -> IO [Contact])
-> ExceptT ChatError (ReaderT ChatController IO) [Contact]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> VersionRangeChat -> User -> IO [Contact]
getDeletedContacts Connection
db VersionRangeChat
vr User
user
      [Contact]
-> (Contact -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Contact]
contacts ((Contact -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Contact -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Contact
ct ->
        (Connection -> ExceptT StoreError IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore (\Connection
db -> Connection -> User -> Contact -> ExceptT StoreError IO ()
deleteContactWithoutGroups Connection
db User
user Contact
ct)
          ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
    cleanupMessages :: ExceptT ChatError (ReaderT ChatController IO) ()
cleanupMessages = do
      UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let cutoffTs :: UTCTime
cutoffTs = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-(NominalDiffTime
30 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay)) UTCTime
ts
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' (Connection -> UTCTime -> IO ()
`deleteOldMessages` UTCTime
cutoffTs)
    cleanupDeliveryTasks :: ExceptT ChatError (ReaderT ChatController IO) ()
cleanupDeliveryTasks = do
      UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let cutoffTs :: UTCTime
cutoffTs = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-(NominalDiffTime
7 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay)) UTCTime
ts
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' (Connection -> UTCTime -> IO ()
`deleteDoneDeliveryTasks` UTCTime
cutoffTs)
    cleanupDeliveryJobs :: ExceptT ChatError (ReaderT ChatController IO) ()
cleanupDeliveryJobs = do
      UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let cutoffTs :: UTCTime
cutoffTs = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-(NominalDiffTime
7 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay)) UTCTime
ts
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' (Connection -> UTCTime -> IO ()
`deleteDoneDeliveryJobs` UTCTime
cutoffTs)
    cleanupProbes :: ExceptT ChatError (ReaderT ChatController IO) ()
cleanupProbes = do
      UTCTime
ts <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let cutoffTs :: UTCTime
cutoffTs = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-(NominalDiffTime
14 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay)) UTCTime
ts
      (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' (Connection -> UTCTime -> IO ()
`deleteOldProbes` UTCTime
cutoffTs)

expireChatItems :: User -> Int64 -> Bool -> CM ()
expireChatItems :: User
-> Int64
-> Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireChatItems user :: User
user@User {Int64
userId :: User -> Int64
userId :: Int64
userId} Int64
globalTTL Bool
sync = do
  UTCTime
currentTs <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  VersionRangeChat
vr <- CM VersionRangeChat
chatVersionRange
  -- this is to keep group messages created during last 12 hours even if they're expired according to item_ts
  let createdAtCutoff :: UTCTime
createdAtCutoff = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
43200 :: NominalDiffTime) UTCTime
currentTs
  ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO ()
waitChatStartedAndActivated
  [Int64]
contactIds <- (Connection -> IO [Int64])
-> ExceptT ChatError (ReaderT ChatController IO) [Int64]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [Int64])
 -> ExceptT ChatError (ReaderT ChatController IO) [Int64])
-> (Connection -> IO [Int64])
-> ExceptT ChatError (ReaderT ChatController IO) [Int64]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> IO [Int64]
getUserContactsToExpire Connection
db User
user Int64
globalTTL
  [Int64]
-> (Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
loop [Int64]
contactIds ((Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> VersionRangeChat
-> Int64
-> Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireContactChatItems User
user VersionRangeChat
vr Int64
globalTTL
  ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO ()
waitChatStartedAndActivated
  [Int64]
groupIds <- (Connection -> IO [Int64])
-> ExceptT ChatError (ReaderT ChatController IO) [Int64]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [Int64])
 -> ExceptT ChatError (ReaderT ChatController IO) [Int64])
-> (Connection -> IO [Int64])
-> ExceptT ChatError (ReaderT ChatController IO) [Int64]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Int64 -> IO [Int64]
getUserGroupsToExpire Connection
db User
user Int64
globalTTL
  [Int64]
-> (Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
loop [Int64]
groupIds ((Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ User
-> VersionRangeChat
-> Int64
-> UTCTime
-> Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireGroupChatItems User
user VersionRangeChat
vr Int64
globalTTL UTCTime
createdAtCutoff
  where
    loop :: [Int64] -> (Int64 -> CM ()) -> CM ()
    loop :: [Int64]
-> (Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
loop [] Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
_ = () -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    loop (Int64
a : [Int64]
as) Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
process = ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
continue (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ do
      Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
process Int64
a ExceptT ChatError (ReaderT ChatController IO) ()
-> (ChatError -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
`catchAllErrors` ChatError -> ExceptT ChatError (ReaderT ChatController IO) ()
eToView
      [Int64]
-> (Int64 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
loop [Int64]
as Int64 -> ExceptT ChatError (ReaderT ChatController IO) ()
process
    continue :: CM () -> CM ()
    continue :: ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
continue ExceptT ChatError (ReaderT ChatController IO) ()
a =
      if Bool
sync
        then ExceptT ChatError (ReaderT ChatController IO) ()
a
        else do
          TMap Int64 Bool
expireFlags <- (ChatController -> TMap Int64 Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (TMap Int64 Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ChatController -> TMap Int64 Bool
expireCIFlags
          Maybe Bool
expire <- STM (Maybe Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Bool)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe Bool)
 -> ExceptT ChatError (ReaderT ChatController IO) (Maybe Bool))
-> STM (Maybe Bool)
-> ExceptT ChatError (ReaderT ChatController IO) (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Int64 -> TMap Int64 Bool -> STM (Maybe Bool)
forall k a. Ord k => k -> TMap k a -> STM (Maybe a)
TM.lookup Int64
userId TMap Int64 Bool
expireFlags
          Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Bool
expire Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ Int -> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
100000 ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> ExceptT ChatError (ReaderT ChatController IO) b
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExceptT ChatError (ReaderT ChatController IO) ()
a

expireContactChatItems :: User -> VersionRangeChat -> Int64 -> ContactId -> CM ()
expireContactChatItems :: User
-> VersionRangeChat
-> Int64
-> Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireContactChatItems User
user VersionRangeChat
vr Int64
globalTTL Int64
ctId =
  -- reading contacts and groups inside the loop,
  -- to allow ttl changing while processing and to reduce memory usage
  CM Contact
-> ExceptT
     ChatError (ReaderT ChatController IO) (Either ChatError Contact)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors ((Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO Contact) -> CM Contact)
-> (Connection -> ExceptT StoreError IO Contact) -> CM Contact
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO Contact
getContact Connection
db VersionRangeChat
vr User
user Int64
ctId) ExceptT
  ChatError (ReaderT ChatController IO) (Either ChatError Contact)
-> (Either ChatError Contact
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Contact -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Either ChatError Contact
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Contact -> ExceptT ChatError (ReaderT ChatController IO) ()
process
  where
    process :: Contact -> ExceptT ChatError (ReaderT ChatController IO) ()
process ct :: Contact
ct@Contact {Maybe Int64
chatItemTTL :: Maybe Int64
chatItemTTL :: Contact -> Maybe Int64
chatItemTTL} =
      Int64
-> Maybe Int64
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
withExpirationDate Int64
globalTTL Maybe Int64
chatItemTTL ((UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \UTCTime
expirationDate -> do
        ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO ()
waitChatStartedAndActivated
        [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> UTCTime -> IO [CIFileInfo]
getContactExpiredFileInfo Connection
db User
user Contact
ct UTCTime
expirationDate
        User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteCIFiles User
user [CIFileInfo]
filesInfo
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> Contact -> UTCTime -> IO ()
deleteContactExpiredCIs Connection
db User
user Contact
ct UTCTime
expirationDate

expireGroupChatItems :: User -> VersionRangeChat -> Int64 -> UTCTime -> GroupId -> CM ()
expireGroupChatItems :: User
-> VersionRangeChat
-> Int64
-> UTCTime
-> Int64
-> ExceptT ChatError (ReaderT ChatController IO) ()
expireGroupChatItems User
user VersionRangeChat
vr Int64
globalTTL UTCTime
createdAtCutoff Int64
groupId =
  CM GroupInfo
-> ExceptT
     ChatError (ReaderT ChatController IO) (Either ChatError GroupInfo)
forall e (m :: * -> *) a.
(AnyError e, MonadUnliftIO m) =>
ExceptT e m a -> ExceptT e m (Either e a)
tryAllErrors ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a. (Connection -> ExceptT StoreError IO a) -> CM a
withStore ((Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo)
-> (Connection -> ExceptT StoreError IO GroupInfo) -> CM GroupInfo
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat
-> User
-> Int64
-> ExceptT StoreError IO GroupInfo
getGroupInfo Connection
db VersionRangeChat
vr User
user Int64
groupId) ExceptT
  ChatError (ReaderT ChatController IO) (Either ChatError GroupInfo)
-> (Either ChatError GroupInfo
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b.
ExceptT ChatError (ReaderT ChatController IO) a
-> (a -> ExceptT ChatError (ReaderT ChatController IO) b)
-> ExceptT ChatError (ReaderT ChatController IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (GroupInfo -> ExceptT ChatError (ReaderT ChatController IO) ())
-> Either ChatError GroupInfo
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GroupInfo -> ExceptT ChatError (ReaderT ChatController IO) ()
process
  where
    process :: GroupInfo -> ExceptT ChatError (ReaderT ChatController IO) ()
process gInfo :: GroupInfo
gInfo@GroupInfo {Maybe Int64
chatItemTTL :: Maybe Int64
chatItemTTL :: GroupInfo -> Maybe Int64
chatItemTTL} =
      Int64
-> Maybe Int64
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
withExpirationDate Int64
globalTTL Maybe Int64
chatItemTTL ((UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \UTCTime
expirationDate -> do
        ReaderT ChatController IO ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT ChatError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT ChatController IO ()
waitChatStartedAndActivated
        [CIFileInfo]
filesInfo <- (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [CIFileInfo]) -> CM [CIFileInfo])
-> (Connection -> IO [CIFileInfo]) -> CM [CIFileInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> User -> GroupInfo -> UTCTime -> UTCTime -> IO [CIFileInfo]
getGroupExpiredFileInfo Connection
db User
user GroupInfo
gInfo UTCTime
expirationDate UTCTime
createdAtCutoff
        User
-> [CIFileInfo] -> ExceptT ChatError (ReaderT ChatController IO) ()
deleteCIFiles User
user [CIFileInfo]
filesInfo
        (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupInfo -> UTCTime -> UTCTime -> IO ()
deleteGroupExpiredCIs Connection
db User
user GroupInfo
gInfo UTCTime
expirationDate UTCTime
createdAtCutoff
        [GroupMember]
membersToDelete <- (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO [GroupMember]) -> CM [GroupMember])
-> (Connection -> IO [GroupMember]) -> CM [GroupMember]
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection
-> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration Connection
db VersionRangeChat
vr User
user GroupInfo
gInfo
        [GroupMember]
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMember]
membersToDelete ((GroupMember -> ExceptT ChatError (ReaderT ChatController IO) ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (GroupMember
    -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \GroupMember
m -> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a. (Connection -> IO a) -> CM a
withStore' ((Connection -> IO ())
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> (Connection -> IO ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ \Connection
db -> Connection -> User -> GroupMember -> IO ()
deleteGroupMember Connection
db User
user GroupMember
m

withExpirationDate :: Int64 -> Maybe Int64 -> (UTCTime -> CM ()) -> CM ()
withExpirationDate :: Int64
-> Maybe Int64
-> (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
withExpirationDate Int64
globalTTL Maybe Int64
chatItemTTL UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ()
action = do
  UTCTime
currentTs <- IO UTCTime -> ExceptT ChatError (ReaderT ChatController IO) UTCTime
forall a. IO a -> ExceptT ChatError (ReaderT ChatController IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let ttl :: Int64
ttl = Int64 -> Maybe Int64 -> Int64
forall a. a -> Maybe a -> a
fromMaybe Int64
globalTTL Maybe Int64
chatItemTTL
  Bool
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
ttl Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (ExceptT ChatError (ReaderT ChatController IO) ()
 -> ExceptT ChatError (ReaderT ChatController IO) ())
-> ExceptT ChatError (ReaderT ChatController IO) ()
-> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ()
action (UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ())
-> UTCTime -> ExceptT ChatError (ReaderT ChatController IO) ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* Int64 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ttl) UTCTime
currentTs

chatCommandP :: Parser ChatCommand
chatCommandP :: Parser ByteString ChatCommand
chatCommandP =
  [Parser ByteString ChatCommand] -> Parser ByteString ChatCommand
forall {a}. [Parser ByteString a] -> Parser ByteString a
choice
    [ Parser ByteString ByteString
"/mute " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((ChatName -> MsgFilter -> ChatCommand
`SetShowMessages` MsgFilter
MFNone) (ChatName -> ChatCommand)
-> Parser ByteString ChatName -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP),
      Parser ByteString ByteString
"/unmute " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((ChatName -> MsgFilter -> ChatCommand
`SetShowMessages` MsgFilter
MFAll) (ChatName -> ChatCommand)
-> Parser ByteString ChatName -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP),
      Parser ByteString ByteString
"/unmute mentions " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((ChatName -> MsgFilter -> ChatCommand
`SetShowMessages` MsgFilter
MFMentions) (ChatName -> ChatCommand)
-> Parser ByteString ChatName -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP),
      Parser ByteString ByteString
"/receipts " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Maybe Bool -> ChatCommand
SetSendReceipts (ChatName -> Maybe Bool -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Maybe Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Maybe Bool -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" " Parser ByteString (Maybe Bool -> ChatCommand)
-> Parser ByteString (Maybe Bool) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
onOffP) Parser ByteString (Maybe Bool)
-> Parser ByteString (Maybe Bool) -> Parser ByteString (Maybe Bool)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"default" Parser ByteString ByteString
-> Maybe Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Bool
forall a. Maybe a
Nothing))),
      Parser ByteString ByteString
"/block #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Bool -> ChatCommand
SetShowMemberMessages (Text -> Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayNameP) Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False),
      Parser ByteString ByteString
"/unblock #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Bool -> ChatCommand
SetShowMemberMessages (Text -> Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayNameP) Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True),
      Parser ByteString ByteString
"/_create user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NewUser -> ChatCommand
CreateActiveUser (NewUser -> ChatCommand)
-> Parser ByteString NewUser -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString NewUser
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/create user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NewUser -> ChatCommand
CreateActiveUser (NewUser -> ChatCommand)
-> Parser ByteString NewUser -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString NewUser
newUserP),
      Parser ByteString ByteString
"/create bot " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NewUser -> ChatCommand
CreateActiveUser (NewUser -> ChatCommand)
-> Parser ByteString NewUser -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString NewUser
newBotUserP),
      Parser ByteString ByteString
"/users" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ListUsers,
      Parser ByteString ByteString
"/_user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Maybe UserPwd -> ChatCommand
APISetActiveUser (Int64 -> Maybe UserPwd -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe UserPwd -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe UserPwd -> ChatCommand)
-> Parser ByteString (Maybe UserPwd)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserPwd -> Parser ByteString (Maybe UserPwd)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString UserPwd -> Parser ByteString UserPwd
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UserPwd
forall a. FromJSON a => Parser a
jsonP)),
      (Parser ByteString ByteString
"/user " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/u ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe UserPwd -> ChatCommand
SetActiveUser (Text -> Maybe UserPwd -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe UserPwd -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe UserPwd -> ChatCommand)
-> Parser ByteString (Maybe UserPwd)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserPwd -> Parser ByteString (Maybe UserPwd)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString UserPwd -> Parser ByteString UserPwd
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UserPwd
pwdP)),
      Parser ByteString ByteString
"/set receipts all " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
SetAllContactReceipts (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/_set receipts contacts " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> UserMsgReceiptSettings -> ChatCommand
APISetUserContactReceipts (Int64 -> UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString UserMsgReceiptSettings
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserMsgReceiptSettings
receiptSettings),
      Parser ByteString ByteString
"/set receipts contacts " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UserMsgReceiptSettings -> ChatCommand
SetUserContactReceipts (UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString UserMsgReceiptSettings
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString UserMsgReceiptSettings
receiptSettings),
      Parser ByteString ByteString
"/_set receipts groups " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> UserMsgReceiptSettings -> ChatCommand
APISetUserGroupReceipts (Int64 -> UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString UserMsgReceiptSettings
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserMsgReceiptSettings
receiptSettings),
      Parser ByteString ByteString
"/set receipts groups " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UserMsgReceiptSettings -> ChatCommand
SetUserGroupReceipts (UserMsgReceiptSettings -> ChatCommand)
-> Parser ByteString UserMsgReceiptSettings
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString UserMsgReceiptSettings
receiptSettings),
      Parser ByteString ByteString
"/_set accept member contacts " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> ChatCommand
APISetUserAutoAcceptMemberContacts (Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/set accept member contacts " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
SetUserAutoAcceptMemberContacts (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/_hide user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> UserPwd -> ChatCommand
APIHideUser (Int64 -> UserPwd -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (UserPwd -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (UserPwd -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (UserPwd -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (UserPwd -> ChatCommand)
-> Parser ByteString UserPwd -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserPwd
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_unhide user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> UserPwd -> ChatCommand
APIUnhideUser (Int64 -> UserPwd -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (UserPwd -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (UserPwd -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (UserPwd -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (UserPwd -> ChatCommand)
-> Parser ByteString UserPwd -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserPwd
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_mute user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIMuteUser (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_unmute user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIUnmuteUser (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/hide user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UserPwd -> ChatCommand
HideUser (UserPwd -> ChatCommand)
-> Parser ByteString UserPwd -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString UserPwd
pwdP),
      Parser ByteString ByteString
"/unhide user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UserPwd -> ChatCommand
UnhideUser (UserPwd -> ChatCommand)
-> Parser ByteString UserPwd -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString UserPwd
pwdP),
      Parser ByteString ByteString
"/mute user" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
MuteUser,
      Parser ByteString ByteString
"/unmute user" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
UnmuteUser,
      Parser ByteString ByteString
"/_delete user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> Maybe UserPwd -> ChatCommand
APIDeleteUser (Int64 -> Bool -> Maybe UserPwd -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> Maybe UserPwd -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> Maybe UserPwd -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Bool -> Maybe UserPwd -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" del_smp=" Parser ByteString (Bool -> Maybe UserPwd -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Maybe UserPwd -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
onOffP Parser ByteString (Maybe UserPwd -> ChatCommand)
-> Parser ByteString (Maybe UserPwd)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserPwd -> Parser ByteString (Maybe UserPwd)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString UserPwd -> Parser ByteString UserPwd
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UserPwd
forall a. FromJSON a => Parser a
jsonP)),
      Parser ByteString ByteString
"/delete user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Bool -> Maybe UserPwd -> ChatCommand
DeleteUser (Text -> Bool -> Maybe UserPwd -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Bool -> Maybe UserPwd -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Bool -> Maybe UserPwd -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Maybe UserPwd -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True Parser ByteString (Maybe UserPwd -> ChatCommand)
-> Parser ByteString (Maybe UserPwd)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UserPwd -> Parser ByteString (Maybe UserPwd)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString UserPwd -> Parser ByteString UserPwd
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UserPwd
pwdP)),
      (Parser ByteString ByteString
"/user" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/u") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ShowActiveUser,
      Parser ByteString ByteString
"/_start " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
        Bool
mainApp <- Parser ByteString ByteString
"main=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP
        Bool
enableSndFiles <- Parser ByteString ByteString
" snd_files=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
mainApp
        ChatCommand -> Parser ByteString ChatCommand
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StartChat {Bool
mainApp :: Bool
mainApp :: Bool
mainApp, Bool
enableSndFiles :: Bool
enableSndFiles :: Bool
enableSndFiles},
      Parser ByteString ByteString
"/_start" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StartChat {mainApp :: Bool
mainApp = Bool
True, enableSndFiles :: Bool
enableSndFiles = Bool
True},
      Parser ByteString ByteString
"/_check running" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
CheckChatRunning,
      Parser ByteString ByteString
"/_stop" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
APIStopChat,
      Parser ByteString ByteString
"/_app activate restore=" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
APIActivateChat (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/_app activate" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> ChatCommand
APIActivateChat Bool
True,
      Parser ByteString ByteString
"/_app suspend " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> ChatCommand
APISuspendChat (Int -> ChatCommand)
-> Parser ByteString Int -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_connections diff" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
ShowConnectionsDiff (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" show_ids=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
      Parser ByteString ByteString
"/_resubscribe all" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ResubscribeAllConnections,
      -- deprecated, use /set file paths
      Parser ByteString ByteString
"/_temp_folder " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> ChatCommand
SetTempFolder (String -> ChatCommand)
-> Parser ByteString String -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
filePath),
      -- /_files_folder deprecated, use /set file paths
      (Parser ByteString ByteString
"/_files_folder " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/files_folder ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> ChatCommand
SetFilesFolder (String -> ChatCommand)
-> Parser ByteString String -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
filePath),
      -- deprecated, use /set file paths
      Parser ByteString ByteString
"/remote_hosts_folder " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> ChatCommand
SetRemoteHostsFolder (String -> ChatCommand)
-> Parser ByteString String -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
filePath),
      Parser ByteString ByteString
"/set file paths " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AppFilePathsConfig -> ChatCommand
APISetAppFilePaths (AppFilePathsConfig -> ChatCommand)
-> Parser ByteString AppFilePathsConfig
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AppFilePathsConfig
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_files_encrypt " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
APISetEncryptLocalFiles (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/contact_merge " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
SetContactMergeEnabled (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
onOffP),
#if !defined(dbPostgres)
      Parser ByteString ByteString
"/_db export " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ArchiveConfig -> ChatCommand
APIExportArchive (ArchiveConfig -> ChatCommand)
-> Parser ByteString ArchiveConfig -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ArchiveConfig
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/db export" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ExportArchive,
      Parser ByteString ByteString
"/_db import " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ArchiveConfig -> ChatCommand
APIImportArchive (ArchiveConfig -> ChatCommand)
-> Parser ByteString ArchiveConfig -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ArchiveConfig
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_db delete" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
APIDeleteStorage,
      Parser ByteString ByteString
"/_db encryption " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DBEncryptionConfig -> ChatCommand
APIStorageEncryption (DBEncryptionConfig -> ChatCommand)
-> Parser ByteString DBEncryptionConfig
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DBEncryptionConfig
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/db encrypt " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DBEncryptionConfig -> ChatCommand
APIStorageEncryption (DBEncryptionConfig -> ChatCommand)
-> (DBEncryptionKey -> DBEncryptionConfig)
-> DBEncryptionKey
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBEncryptionKey -> DBEncryptionKey -> DBEncryptionConfig
dbEncryptionConfig DBEncryptionKey
"" (DBEncryptionKey -> ChatCommand)
-> Parser ByteString DBEncryptionKey
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DBEncryptionKey
dbKeyP),
      Parser ByteString ByteString
"/db key " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DBEncryptionConfig -> ChatCommand
APIStorageEncryption (DBEncryptionConfig -> ChatCommand)
-> Parser ByteString DBEncryptionConfig
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DBEncryptionKey -> DBEncryptionKey -> DBEncryptionConfig
dbEncryptionConfig (DBEncryptionKey -> DBEncryptionKey -> DBEncryptionConfig)
-> Parser ByteString DBEncryptionKey
-> Parser ByteString (DBEncryptionKey -> DBEncryptionConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DBEncryptionKey
dbKeyP Parser ByteString (DBEncryptionKey -> DBEncryptionConfig)
-> Parser ByteString Char
-> Parser ByteString (DBEncryptionKey -> DBEncryptionConfig)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (DBEncryptionKey -> DBEncryptionConfig)
-> Parser ByteString DBEncryptionKey
-> Parser ByteString DBEncryptionConfig
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString DBEncryptionKey
dbKeyP)),
      Parser ByteString ByteString
"/db decrypt " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DBEncryptionConfig -> ChatCommand
APIStorageEncryption (DBEncryptionConfig -> ChatCommand)
-> (DBEncryptionKey -> DBEncryptionConfig)
-> DBEncryptionKey
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DBEncryptionKey -> DBEncryptionKey -> DBEncryptionConfig
`dbEncryptionConfig` DBEncryptionKey
"") (DBEncryptionKey -> ChatCommand)
-> Parser ByteString DBEncryptionKey
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DBEncryptionKey
dbKeyP),
      Parser ByteString ByteString
"/db test key " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DBEncryptionKey -> ChatCommand
TestStorageEncryption (DBEncryptionKey -> ChatCommand)
-> Parser ByteString DBEncryptionKey
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DBEncryptionKey
dbKeyP),
      Parser ByteString ByteString
"/sql slow" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
SlowSQLQueries,
#endif
      Parser ByteString ByteString
"/_save app settings" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AppSettings -> ChatCommand
APISaveAppSettings (AppSettings -> ChatCommand)
-> Parser ByteString AppSettings -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AppSettings
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_get app settings" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe AppSettings -> ChatCommand
APIGetAppSettings (Maybe AppSettings -> ChatCommand)
-> Parser ByteString (Maybe AppSettings)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AppSettings
-> Parser ByteString (Maybe AppSettings)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString AppSettings -> Parser ByteString AppSettings
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString AppSettings
forall a. FromJSON a => Parser a
jsonP)),
      Parser ByteString ByteString
"/sql chat " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ExecChatStoreSQL (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
textP),
      Parser ByteString ByteString
"/sql agent " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ExecAgentStoreSQL (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
textP),
      Parser ByteString ByteString
"/_get tags " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIGetChatTags (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_get chats "
        Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( Int64 -> Bool -> PaginationByTime -> ChatListQuery -> ChatCommand
APIGetChats
              (Int64 -> Bool -> PaginationByTime -> ChatListQuery -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString
     (Bool -> PaginationByTime -> ChatListQuery -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal
              Parser
  ByteString
  (Bool -> PaginationByTime -> ChatListQuery -> ChatCommand)
-> Parser ByteString Bool
-> Parser
     ByteString (PaginationByTime -> ChatListQuery -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" pcc=on" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
" pcc=off" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
              Parser
  ByteString (PaginationByTime -> ChatListQuery -> ChatCommand)
-> Parser ByteString PaginationByTime
-> Parser ByteString (ChatListQuery -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString PaginationByTime
-> Parser ByteString PaginationByTime
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString PaginationByTime
paginationByTimeP Parser ByteString PaginationByTime
-> Parser ByteString PaginationByTime
-> Parser ByteString PaginationByTime
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PaginationByTime -> Parser ByteString PaginationByTime
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> PaginationByTime
PTLast Int
5000))
              Parser ByteString (ChatListQuery -> ChatCommand)
-> Parser ByteString ChatListQuery -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString ChatListQuery
-> Parser ByteString ChatListQuery
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ChatListQuery
forall a. FromJSON a => Parser a
jsonP Parser ByteString ChatListQuery
-> Parser ByteString ChatListQuery
-> Parser ByteString ChatListQuery
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ChatListQuery -> Parser ByteString ChatListQuery
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatListQuery
clqNoFilters)
           ),
      Parser ByteString ByteString
"/_get chat " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef
-> Maybe MsgContentTag
-> ChatPagination
-> Maybe Text
-> ChatCommand
APIGetChat (ChatRef
 -> Maybe MsgContentTag
 -> ChatPagination
 -> Maybe Text
 -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser
     ByteString
     (Maybe MsgContentTag
      -> ChatPagination -> Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser
  ByteString
  (Maybe MsgContentTag
   -> ChatPagination -> Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe MsgContentTag)
-> Parser ByteString (ChatPagination -> Maybe Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString MsgContentTag
-> Parser ByteString (Maybe MsgContentTag)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" content=" Parser ByteString ByteString
-> Parser ByteString MsgContentTag
-> Parser ByteString MsgContentTag
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgContentTag
forall a. StrEncoding a => Parser a
strP) Parser ByteString (ChatPagination -> Maybe Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ChatPagination -> Maybe Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ChatPagination -> Maybe Text -> ChatCommand)
-> Parser ByteString ChatPagination
-> Parser ByteString (Maybe Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatPagination
chatPaginationP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" search=" Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP)),
      Parser ByteString ByteString
"/_get items " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatPagination -> Maybe Text -> ChatCommand
APIGetChatItems (ChatPagination -> Maybe Text -> ChatCommand)
-> Parser ByteString ChatPagination
-> Parser ByteString (Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatPagination
chatPaginationP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" search=" Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP)),
      Parser ByteString ByteString
"/_get item info " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> Int64 -> ChatCommand
APIGetChatItemInfo (ChatRef -> Int64 -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_send " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SendRef
-> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand
APISendMessages (SendRef
 -> Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand)
-> Parser ByteString SendRef
-> Parser
     ByteString
     (Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SendRef
sendRefP Parser
  ByteString
  (Bool -> Maybe Int -> NonEmpty ComposedMessage -> ChatCommand)
-> Parser ByteString Bool
-> Parser
     ByteString (Maybe Int -> NonEmpty ComposedMessage -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
liveMessageP Parser
  ByteString (Maybe Int -> NonEmpty ComposedMessage -> ChatCommand)
-> Parser ByteString (Maybe Int)
-> Parser ByteString (NonEmpty ComposedMessage -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Int)
sendMessageTTLP Parser ByteString (NonEmpty ComposedMessage -> ChatCommand)
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" json " Parser ByteString ByteString
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (NonEmpty ComposedMessage)
forall a. FromJSON a => Parser a
jsonP Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
" text " Parser ByteString ByteString
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (NonEmpty ComposedMessage)
composedMessagesTextP)),
      Parser ByteString ByteString
"/_create tag " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatTagData -> ChatCommand
APICreateChatTag (ChatTagData -> ChatCommand)
-> Parser ByteString ChatTagData -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatTagData
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_tags " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> Maybe (NonEmpty Int64) -> ChatCommand
APISetChatTags (ChatRef -> Maybe (NonEmpty Int64) -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (Maybe (NonEmpty Int64) -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (Maybe (NonEmpty Int64) -> ChatCommand)
-> Parser ByteString (Maybe (NonEmpty Int64))
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
-> Parser ByteString (Maybe (NonEmpty Int64))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/_delete tag " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIDeleteChatTag (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_update tag " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatTagData -> ChatCommand
APIUpdateChatTag (Int64 -> ChatTagData -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (ChatTagData -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (ChatTagData -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ChatTagData -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ChatTagData -> ChatCommand)
-> Parser ByteString ChatTagData -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatTagData
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_reorder tags " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NonEmpty Int64 -> ChatCommand
APIReorderChatTags (NonEmpty Int64 -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_create *" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty ComposedMessage -> ChatCommand
APICreateChatItems (Int64 -> NonEmpty ComposedMessage -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (NonEmpty ComposedMessage -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (NonEmpty ComposedMessage -> ChatCommand)
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" json " Parser ByteString ByteString
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (NonEmpty ComposedMessage)
forall a. FromJSON a => Parser a
jsonP Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
" text " Parser ByteString ByteString
-> Parser ByteString (NonEmpty ComposedMessage)
-> Parser ByteString (NonEmpty ComposedMessage)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (NonEmpty ComposedMessage)
composedMessagesTextP)),
      Parser ByteString ByteString
"/_report #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ReportReason -> Text -> ChatCommand
APIReportMessage (Int64 -> Int64 -> ReportReason -> Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ReportReason -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ReportReason -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ReportReason -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ReportReason -> Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (ReportReason -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (ReportReason -> Text -> ChatCommand)
-> Parser ByteString ReportReason
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" reason=" Parser ByteString ByteString
-> Parser ByteString ReportReason -> Parser ByteString ReportReason
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ReportReason
forall a. StrEncoding a => Parser a
strP) Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"")),
      Parser ByteString ByteString
"/report #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> ReportReason -> Text -> ChatCommand
ReportMessage (Text -> Maybe Text -> ReportReason -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser
     ByteString (Maybe Text -> ReportReason -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser
  ByteString (Maybe Text -> ReportReason -> Text -> ChatCommand)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (ReportReason -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" @" Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayNameP) Parser ByteString (ReportReason -> Text -> ChatCommand)
-> Parser ByteString ReportReason
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ReportReason
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP),
      Parser ByteString ByteString
"/_update item " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> Int64 -> Bool -> UpdatedMessage -> ChatCommand
APIUpdateChatItem (ChatRef -> Int64 -> Bool -> UpdatedMessage -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser
     ByteString (Int64 -> Bool -> UpdatedMessage -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (Int64 -> Bool -> UpdatedMessage -> ChatCommand)
-> Parser ByteString Char
-> Parser
     ByteString (Int64 -> Bool -> UpdatedMessage -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> Bool -> UpdatedMessage -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> UpdatedMessage -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> UpdatedMessage -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (UpdatedMessage -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
liveMessageP Parser ByteString (UpdatedMessage -> ChatCommand)
-> Parser ByteString UpdatedMessage
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" json" Parser ByteString ByteString
-> Parser ByteString UpdatedMessage
-> Parser ByteString UpdatedMessage
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UpdatedMessage
forall a. FromJSON a => Parser a
jsonP Parser ByteString UpdatedMessage
-> Parser ByteString UpdatedMessage
-> Parser ByteString UpdatedMessage
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
" text " Parser ByteString ByteString
-> Parser ByteString UpdatedMessage
-> Parser ByteString UpdatedMessage
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UpdatedMessage
updatedMessagesTextP)),
      Parser ByteString ByteString
"/_delete item " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> NonEmpty Int64 -> CIDeleteMode -> ChatCommand
APIDeleteChatItem (ChatRef -> NonEmpty Int64 -> CIDeleteMode -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser
     ByteString (NonEmpty Int64 -> CIDeleteMode -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (NonEmpty Int64 -> CIDeleteMode -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString (CIDeleteMode -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP Parser ByteString (CIDeleteMode -> ChatCommand)
-> Parser ByteString CIDeleteMode -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CIDeleteMode
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/_delete member item #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty Int64 -> ChatCommand
APIDeleteMemberChatItem (Int64 -> NonEmpty Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (NonEmpty Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (NonEmpty Int64 -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/_archive reports #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIArchiveReceivedReports (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_delete reports #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty Int64 -> CIDeleteMode -> ChatCommand
APIDeleteReceivedReports (Int64 -> NonEmpty Int64 -> CIDeleteMode -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString (NonEmpty Int64 -> CIDeleteMode -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (NonEmpty Int64 -> CIDeleteMode -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString (CIDeleteMode -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP Parser ByteString (CIDeleteMode -> ChatCommand)
-> Parser ByteString CIDeleteMode -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CIDeleteMode
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/_reaction " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> Int64 -> Bool -> MsgReaction -> ChatCommand
APIChatItemReaction (ChatRef -> Int64 -> Bool -> MsgReaction -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (Int64 -> Bool -> MsgReaction -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (Int64 -> Bool -> MsgReaction -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> Bool -> MsgReaction -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> Bool -> MsgReaction -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> MsgReaction -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> MsgReaction -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Bool -> MsgReaction -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Bool -> MsgReaction -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (MsgReaction -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
onOffP Parser ByteString (MsgReaction -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (MsgReaction -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (MsgReaction -> ChatCommand)
-> Parser ByteString MsgReaction -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MsgReaction -> Either String MsgReaction
knownReaction (MsgReaction -> Either String MsgReaction)
-> Parser ByteString MsgReaction -> Parser ByteString MsgReaction
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString MsgReaction
forall a. FromJSON a => Parser a
jsonP)),
      Parser ByteString ByteString
"/_reaction members " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> Int64 -> MsgReaction -> ChatCommand
APIGetReactionMembers (Int64 -> Int64 -> Int64 -> MsgReaction -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> Int64 -> MsgReaction -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> Int64 -> MsgReaction -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Int64 -> Int64 -> MsgReaction -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" #" Parser ByteString (Int64 -> Int64 -> MsgReaction -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> MsgReaction -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> MsgReaction -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> MsgReaction -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> MsgReaction -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (MsgReaction -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (MsgReaction -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (MsgReaction -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (MsgReaction -> ChatCommand)
-> Parser ByteString MsgReaction -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MsgReaction -> Either String MsgReaction
knownReaction (MsgReaction -> Either String MsgReaction)
-> Parser ByteString MsgReaction -> Parser ByteString MsgReaction
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString MsgReaction
forall a. FromJSON a => Parser a
jsonP)),
      Parser ByteString ByteString
"/_forward plan " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> NonEmpty Int64 -> ChatCommand
APIPlanForwardChatItems (ChatRef -> NonEmpty Int64 -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (NonEmpty Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (NonEmpty Int64 -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/_forward " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand
APIForwardChatItems (ChatRef -> ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser
     ByteString (ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser
  ByteString (ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand)
-> Parser ByteString Char
-> Parser
     ByteString (ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser
  ByteString (ChatRef -> NonEmpty Int64 -> Maybe Int -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (NonEmpty Int64 -> Maybe Int -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatRef
chatRefP Parser ByteString (NonEmpty Int64 -> Maybe Int -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString (Maybe Int -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Maybe Int -> ChatCommand)
-> Parser ByteString (Maybe Int) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Int)
sendMessageTTLP),
      Parser ByteString ByteString
"/_read user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIUserRead (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/read user" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
UserRead,
      Parser ByteString ByteString
"/_read chat " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> ChatCommand
APIChatRead (ChatRef -> ChatCommand)
-> Parser ByteString ChatRef -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP),
      Parser ByteString ByteString
"/_read chat items " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> NonEmpty Int64 -> ChatCommand
APIChatItemsRead (ChatRef -> NonEmpty Int64 -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (NonEmpty Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (NonEmpty Int64 -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/_unread chat " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> Bool -> ChatCommand
APIChatUnread (ChatRef -> Bool -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/_delete " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> ChatDeleteMode -> ChatCommand
APIDeleteChat (ChatRef -> ChatDeleteMode -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (ChatDeleteMode -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (ChatDeleteMode -> ChatCommand)
-> Parser ByteString ChatDeleteMode
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatDeleteMode
chatDeleteMode),
      Parser ByteString ByteString
"/_clear chat " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> ChatCommand
APIClearChat (ChatRef -> ChatCommand)
-> Parser ByteString ChatRef -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP),
      Parser ByteString ByteString
"/_accept" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> Int64 -> ChatCommand
APIAcceptContact (Bool -> Int64 -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
incognitoOnOffP Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_reject " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIRejectContact (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_call invite @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> CallType -> ChatCommand
APISendCallInvitation (Int64 -> CallType -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (CallType -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (CallType -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (CallType -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (CallType -> ChatCommand)
-> Parser ByteString CallType -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CallType
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/call " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> CallType -> ChatCommand
SendCallInvitation (Text -> CallType -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (CallType -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (CallType -> ChatCommand)
-> Parser ByteString CallType -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CallType -> Parser ByteString CallType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CallType
defaultCallType),
      Parser ByteString ByteString
"/_call reject @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIRejectCall (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_call offer @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> WebRTCCallOffer -> ChatCommand
APISendCallOffer (Int64 -> WebRTCCallOffer -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (WebRTCCallOffer -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (WebRTCCallOffer -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (WebRTCCallOffer -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (WebRTCCallOffer -> ChatCommand)
-> Parser ByteString WebRTCCallOffer
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString WebRTCCallOffer
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_call answer @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> WebRTCSession -> ChatCommand
APISendCallAnswer (Int64 -> WebRTCSession -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (WebRTCSession -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (WebRTCSession -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (WebRTCSession -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (WebRTCSession -> ChatCommand)
-> Parser ByteString WebRTCSession -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString WebRTCSession
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_call extra @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> WebRTCExtraInfo -> ChatCommand
APISendCallExtraInfo (Int64 -> WebRTCExtraInfo -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (WebRTCExtraInfo -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (WebRTCExtraInfo -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (WebRTCExtraInfo -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (WebRTCExtraInfo -> ChatCommand)
-> Parser ByteString WebRTCExtraInfo
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString WebRTCExtraInfo
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_call end @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIEndCall (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_call status @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> WebRTCCallStatus -> ChatCommand
APICallStatus (Int64 -> WebRTCCallStatus -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (WebRTCCallStatus -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (WebRTCCallStatus -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (WebRTCCallStatus -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (WebRTCCallStatus -> ChatCommand)
-> Parser ByteString WebRTCCallStatus
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString WebRTCCallStatus
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_call get" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
APIGetCallInvitations,
      Parser ByteString ByteString
"/_profile " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Profile -> ChatCommand
APIUpdateProfile (Int64 -> Profile -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Profile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Profile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Profile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Profile -> ChatCommand)
-> Parser ByteString Profile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Profile
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_set alias @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Text -> ChatCommand
APISetContactAlias (Int64 -> Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"")),
      Parser ByteString ByteString
"/_set alias #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Text -> ChatCommand
APISetGroupAlias (Int64 -> Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"")),
      Parser ByteString ByteString
"/_set alias :" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Text -> ChatCommand
APISetConnectionAlias (Int64 -> Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"")),
      Parser ByteString ByteString
"/_set prefs @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Preferences -> ChatCommand
APISetContactPrefs (Int64 -> Preferences -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Preferences -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Preferences -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Preferences -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Preferences -> ChatCommand)
-> Parser ByteString Preferences -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Preferences
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_set theme user " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Maybe UIThemeEntityOverrides -> ChatCommand
APISetUserUIThemes (Int64 -> Maybe UIThemeEntityOverrides -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe UIThemeEntityOverrides -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe UIThemeEntityOverrides -> ChatCommand)
-> Parser ByteString (Maybe UIThemeEntityOverrides)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UIThemeEntityOverrides
-> Parser ByteString (Maybe UIThemeEntityOverrides)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString UIThemeEntityOverrides
-> Parser ByteString UIThemeEntityOverrides
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UIThemeEntityOverrides
forall a. FromJSON a => Parser a
jsonP)),
      Parser ByteString ByteString
"/_set theme " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> Maybe UIThemeEntityOverrides -> ChatCommand
APISetChatUIThemes (ChatRef -> Maybe UIThemeEntityOverrides -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (Maybe UIThemeEntityOverrides -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (Maybe UIThemeEntityOverrides -> ChatCommand)
-> Parser ByteString (Maybe UIThemeEntityOverrides)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UIThemeEntityOverrides
-> Parser ByteString (Maybe UIThemeEntityOverrides)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString UIThemeEntityOverrides
-> Parser ByteString UIThemeEntityOverrides
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UIThemeEntityOverrides
forall a. FromJSON a => Parser a
jsonP)),
      Parser ByteString ByteString
"/_ntf get" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
APIGetNtfToken,
      Parser ByteString ByteString
"/_ntf register " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DeviceToken -> NotificationsMode -> ChatCommand
APIRegisterToken (DeviceToken -> NotificationsMode -> ChatCommand)
-> Parser ByteString DeviceToken
-> Parser ByteString (NotificationsMode -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DeviceToken
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (NotificationsMode -> ChatCommand)
-> Parser ByteString NotificationsMode
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString NotificationsMode
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_ntf verify " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DeviceToken -> CbNonce -> ByteString -> ChatCommand
APIVerifyToken (DeviceToken -> CbNonce -> ByteString -> ChatCommand)
-> Parser ByteString DeviceToken
-> Parser ByteString (CbNonce -> ByteString -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DeviceToken
forall a. StrEncoding a => Parser a
strP Parser ByteString (CbNonce -> ByteString -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (CbNonce -> ByteString -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (CbNonce -> ByteString -> ChatCommand)
-> Parser ByteString CbNonce
-> Parser ByteString (ByteString -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CbNonce
forall a. StrEncoding a => Parser a
strP Parser ByteString (ByteString -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ByteString -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ByteString -> ChatCommand)
-> Parser ByteString ByteString -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_ntf check " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DeviceToken -> ChatCommand
APICheckToken (DeviceToken -> ChatCommand)
-> Parser ByteString DeviceToken -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DeviceToken
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_ntf delete " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (DeviceToken -> ChatCommand
APIDeleteToken (DeviceToken -> ChatCommand)
-> Parser ByteString DeviceToken -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString DeviceToken
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_ntf conns " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (CbNonce -> ByteString -> ChatCommand
APIGetNtfConns (CbNonce -> ByteString -> ChatCommand)
-> Parser ByteString CbNonce
-> Parser ByteString (ByteString -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString CbNonce
forall a. StrEncoding a => Parser a
strP Parser ByteString (ByteString -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ByteString -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ByteString -> ChatCommand)
-> Parser ByteString ByteString -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_ntf conn messages " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NonEmpty ConnMsgReq -> ChatCommand
APIGetConnNtfMessages (NonEmpty ConnMsgReq -> ChatCommand)
-> Parser ByteString (NonEmpty ConnMsgReq)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty ConnMsgReq)
connMsgsP),
      Parser ByteString ByteString
"/_add #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> GroupMemberRole -> ChatCommand
APIAddMember (Int64 -> Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/_join #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> MsgFilter -> ChatCommand
APIJoinGroup (Int64 -> MsgFilter -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (MsgFilter -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (MsgFilter -> ChatCommand)
-> Parser ByteString MsgFilter -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MsgFilter -> Parser ByteString MsgFilter
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgFilter
MFAll), -- needs to be changed to support in UI
      Parser ByteString ByteString
"/_accept member #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> GroupMemberRole -> ChatCommand
APIAcceptMember (Int64 -> Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/_delete member chat #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIDeleteMemberSupportChat (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_member role #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty Int64 -> GroupMemberRole -> ChatCommand
APIMembersRole (Int64 -> NonEmpty Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString (NonEmpty Int64 -> GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser
  ByteString (NonEmpty Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/_block #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty Int64 -> Bool -> ChatCommand
APIBlockMembersForAll (Int64 -> NonEmpty Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (NonEmpty Int64 -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (NonEmpty Int64 -> Bool -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" blocked=" Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/_remove #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty Int64 -> Bool -> ChatCommand
APIRemoveMembers (Int64 -> NonEmpty Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (NonEmpty Int64 -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (NonEmpty Int64 -> Bool -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" messages=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
      Parser ByteString ByteString
"/_leave #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APILeaveGroup (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_members #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIListMembers (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      -- "/_archive conversations #" *> (APIArchiveGroupConversations <$> A.decimal <*> _strP),
      -- "/_delete conversations #" *> (APIDeleteGroupConversations <$> A.decimal <*> _strP),
      Parser ByteString ByteString
"/_server test " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> AProtoServerWithAuth -> ChatCommand
APITestProtoServer (Int64 -> AProtoServerWithAuth -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (AProtoServerWithAuth -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (AProtoServerWithAuth -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (AProtoServerWithAuth -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (AProtoServerWithAuth -> ChatCommand)
-> Parser ByteString AProtoServerWithAuth
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString AProtoServerWithAuth
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/smp test " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AProtoServerWithAuth -> ChatCommand
TestProtoServer (AProtoServerWithAuth -> ChatCommand)
-> (ProtoServerWithAuth 'PSMP -> AProtoServerWithAuth)
-> ProtoServerWithAuth 'PSMP
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SProtocolType 'PSMP
-> ProtoServerWithAuth 'PSMP -> AProtoServerWithAuth
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> ProtoServerWithAuth p -> AProtoServerWithAuth
AProtoServerWithAuth SProtocolType 'PSMP
SPSMP (ProtoServerWithAuth 'PSMP -> ChatCommand)
-> Parser ByteString (ProtoServerWithAuth 'PSMP)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (ProtoServerWithAuth 'PSMP)
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/xftp test " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AProtoServerWithAuth -> ChatCommand
TestProtoServer (AProtoServerWithAuth -> ChatCommand)
-> (ProtoServerWithAuth 'PXFTP -> AProtoServerWithAuth)
-> ProtoServerWithAuth 'PXFTP
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SProtocolType 'PXFTP
-> ProtoServerWithAuth 'PXFTP -> AProtoServerWithAuth
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> ProtoServerWithAuth p -> AProtoServerWithAuth
AProtoServerWithAuth SProtocolType 'PXFTP
SPXFTP (ProtoServerWithAuth 'PXFTP -> ChatCommand)
-> Parser ByteString (ProtoServerWithAuth 'PXFTP)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (ProtoServerWithAuth 'PXFTP)
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/ntf test " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AProtoServerWithAuth -> ChatCommand
TestProtoServer (AProtoServerWithAuth -> ChatCommand)
-> (ProtoServerWithAuth 'PNTF -> AProtoServerWithAuth)
-> ProtoServerWithAuth 'PNTF
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SProtocolType 'PNTF
-> ProtoServerWithAuth 'PNTF -> AProtoServerWithAuth
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> ProtoServerWithAuth p -> AProtoServerWithAuth
AProtoServerWithAuth SProtocolType 'PNTF
SPNTF (ProtoServerWithAuth 'PNTF -> ChatCommand)
-> Parser ByteString (ProtoServerWithAuth 'PNTF)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (ProtoServerWithAuth 'PNTF)
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/smp " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AProtocolType -> [AProtoServerWithAuth] -> ChatCommand
SetUserProtoServers (SProtocolType 'PSMP -> AProtocolType
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> AProtocolType
AProtocolType SProtocolType 'PSMP
SPSMP) ([AProtoServerWithAuth] -> ChatCommand)
-> ([ProtoServerWithAuth 'PSMP] -> [AProtoServerWithAuth])
-> [ProtoServerWithAuth 'PSMP]
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtoServerWithAuth 'PSMP -> AProtoServerWithAuth)
-> [ProtoServerWithAuth 'PSMP] -> [AProtoServerWithAuth]
forall a b. (a -> b) -> [a] -> [b]
map (SProtocolType 'PSMP
-> ProtoServerWithAuth 'PSMP -> AProtoServerWithAuth
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> ProtoServerWithAuth p -> AProtoServerWithAuth
AProtoServerWithAuth SProtocolType 'PSMP
SPSMP) ([ProtoServerWithAuth 'PSMP] -> ChatCommand)
-> Parser ByteString [ProtoServerWithAuth 'PSMP]
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ProtoServerWithAuth 'PSMP]
forall (p :: ProtocolType).
ProtocolTypeI p =>
Parser [ProtoServerWithAuth p]
protocolServersP),
      Parser ByteString ByteString
"/xftp " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AProtocolType -> [AProtoServerWithAuth] -> ChatCommand
SetUserProtoServers (SProtocolType 'PXFTP -> AProtocolType
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> AProtocolType
AProtocolType SProtocolType 'PXFTP
SPXFTP) ([AProtoServerWithAuth] -> ChatCommand)
-> ([ProtoServerWithAuth 'PXFTP] -> [AProtoServerWithAuth])
-> [ProtoServerWithAuth 'PXFTP]
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtoServerWithAuth 'PXFTP -> AProtoServerWithAuth)
-> [ProtoServerWithAuth 'PXFTP] -> [AProtoServerWithAuth]
forall a b. (a -> b) -> [a] -> [b]
map (SProtocolType 'PXFTP
-> ProtoServerWithAuth 'PXFTP -> AProtoServerWithAuth
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> ProtoServerWithAuth p -> AProtoServerWithAuth
AProtoServerWithAuth SProtocolType 'PXFTP
SPXFTP) ([ProtoServerWithAuth 'PXFTP] -> ChatCommand)
-> Parser ByteString [ProtoServerWithAuth 'PXFTP]
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ProtoServerWithAuth 'PXFTP]
forall (p :: ProtocolType).
ProtocolTypeI p =>
Parser [ProtoServerWithAuth p]
protocolServersP),
      Parser ByteString ByteString
"/smp" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AProtocolType -> ChatCommand
GetUserProtoServers (SProtocolType 'PSMP -> AProtocolType
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> AProtocolType
AProtocolType SProtocolType 'PSMP
SPSMP),
      Parser ByteString ByteString
"/xftp" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AProtocolType -> ChatCommand
GetUserProtoServers (SProtocolType 'PXFTP -> AProtocolType
forall (p :: ProtocolType).
ProtocolTypeI p =>
SProtocolType p -> AProtocolType
AProtocolType SProtocolType 'PXFTP
SPXFTP),
      Parser ByteString ByteString
"/_operators" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
APIGetServerOperators,
      Parser ByteString ByteString
"/_operators " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NonEmpty ServerOperator -> ChatCommand
APISetServerOperators (NonEmpty ServerOperator -> ChatCommand)
-> Parser ByteString (NonEmpty ServerOperator)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (NonEmpty ServerOperator)
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/operators " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NonEmpty ServerOperatorRoles -> ChatCommand
SetServerOperators (NonEmpty ServerOperatorRoles -> ChatCommand)
-> ([ServerOperatorRoles] -> NonEmpty ServerOperatorRoles)
-> [ServerOperatorRoles]
-> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ServerOperatorRoles] -> NonEmpty ServerOperatorRoles
forall a. HasCallStack => [a] -> NonEmpty a
L.fromList ([ServerOperatorRoles] -> ChatCommand)
-> Parser ByteString [ServerOperatorRoles]
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ServerOperatorRoles
operatorRolesP Parser ByteString ServerOperatorRoles
-> Parser ByteString Char
-> Parser ByteString [ServerOperatorRoles]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
','),
      Parser ByteString ByteString
"/_servers " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIGetUserServers (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_servers " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty UpdatedUserOperatorServers -> ChatCommand
APISetUserServers (Int64 -> NonEmpty UpdatedUserOperatorServers -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString (NonEmpty UpdatedUserOperatorServers -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser
  ByteString (NonEmpty UpdatedUserOperatorServers -> ChatCommand)
-> Parser ByteString Char
-> Parser
     ByteString (NonEmpty UpdatedUserOperatorServers -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser
  ByteString (NonEmpty UpdatedUserOperatorServers -> ChatCommand)
-> Parser ByteString (NonEmpty UpdatedUserOperatorServers)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty UpdatedUserOperatorServers)
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_validate_servers " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> [UpdatedUserOperatorServers] -> ChatCommand
APIValidateServers (Int64 -> [UpdatedUserOperatorServers] -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString ([UpdatedUserOperatorServers] -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString ([UpdatedUserOperatorServers] -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString ([UpdatedUserOperatorServers] -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString ([UpdatedUserOperatorServers] -> ChatCommand)
-> Parser ByteString [UpdatedUserOperatorServers]
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString [UpdatedUserOperatorServers]
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_conditions" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
APIGetUsageConditions,
      Parser ByteString ByteString
"/_conditions_notified " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APISetConditionsNotified (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_accept_conditions " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> NonEmpty Int64 -> ChatCommand
APIAcceptConditions (Int64 -> NonEmpty Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (NonEmpty Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (NonEmpty Int64 -> ChatCommand)
-> Parser ByteString (NonEmpty Int64)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (NonEmpty Int64)
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/_ttl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APISetChatItemTTL (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_ttl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatRef -> Maybe Int64 -> ChatCommand
APISetChatTTL (Int64 -> ChatRef -> Maybe Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (ChatRef -> Maybe Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (ChatRef -> Maybe Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ChatRef -> Maybe Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ChatRef -> Maybe Int64 -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (Maybe Int64 -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatRef
chatRefP Parser ByteString (Maybe Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe Int64 -> ChatCommand)
-> Parser ByteString (Maybe Int64) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Int64)
ciTTLDecimal),
      Parser ByteString ByteString
"/_ttl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIGetChatItemTTL (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/ttl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
SetChatItemTTL (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
ciTTL),
      Parser ByteString ByteString
"/ttl" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
GetChatItemTTL,
      Parser ByteString ByteString
"/ttl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Maybe Int64 -> ChatCommand
SetChatTTL (ChatName -> Maybe Int64 -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Maybe Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Maybe Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe Int64 -> ChatCommand)
-> Parser ByteString (Maybe Int64) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Parser ByteString ByteString
"default" Parser ByteString ByteString
-> Maybe Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Int64
forall a. Maybe a
Nothing) Parser ByteString (Maybe Int64)
-> Parser ByteString (Maybe Int64)
-> Parser ByteString (Maybe Int64)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64)
-> Parser ByteString Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
ciTTL))),
      Parser ByteString ByteString
"/ttl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> ChatCommand
GetChatTTL (ChatName -> ChatCommand)
-> Parser ByteString ChatName -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP),
      Parser ByteString ByteString
"/_network info " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (UserNetworkInfo -> ChatCommand
APISetNetworkInfo (UserNetworkInfo -> ChatCommand)
-> Parser ByteString UserNetworkInfo
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString UserNetworkInfo
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_network " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (NetworkConfig -> ChatCommand
APISetNetworkConfig (NetworkConfig -> ChatCommand)
-> Parser ByteString NetworkConfig -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString NetworkConfig
forall a. FromJSON a => Parser a
jsonP),
      (Parser ByteString ByteString
"/network " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/net ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SimpleNetCfg -> ChatCommand
SetNetworkConfig (SimpleNetCfg -> ChatCommand)
-> Parser ByteString SimpleNetCfg -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SimpleNetCfg
netCfgP),
      (Parser ByteString ByteString
"/network" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/net") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
APIGetNetworkConfig,
      Parser ByteString ByteString
"/reconnect " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> SMPServer -> ChatCommand
ReconnectServer (Int64 -> SMPServer -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (SMPServer -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (SMPServer -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (SMPServer -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (SMPServer -> ChatCommand)
-> Parser ByteString SMPServer -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString SMPServer
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/reconnect" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ReconnectAllServers,
      Parser ByteString ByteString
"/_settings " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatRef -> ChatSettings -> ChatCommand
APISetChatSettings (ChatRef -> ChatSettings -> ChatCommand)
-> Parser ByteString ChatRef
-> Parser ByteString (ChatSettings -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatRef
chatRefP Parser ByteString (ChatSettings -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ChatSettings -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ChatSettings -> ChatCommand)
-> Parser ByteString ChatSettings -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatSettings
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_member settings #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> GroupMemberSettings -> ChatCommand
APISetMemberSettings (Int64 -> Int64 -> GroupMemberSettings -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> GroupMemberSettings -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> GroupMemberSettings -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> GroupMemberSettings -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> GroupMemberSettings -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (GroupMemberSettings -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (GroupMemberSettings -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (GroupMemberSettings -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (GroupMemberSettings -> ChatCommand)
-> Parser ByteString GroupMemberSettings
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberSettings
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_info #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIGroupMemberInfo (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_info #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIGroupInfo (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_info @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIContactInfo (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/info #" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/i #") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> ChatCommand
GroupMemberInfo (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/info #" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/i #") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ShowGroupInfo (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/info " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/i ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ContactInfo (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/_queue info #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIGroupMemberQueueInfo (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_queue info @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIContactQueueInfo (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/queue info #" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/qi #") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> ChatCommand
GroupMemberQueueInfo (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/queue info " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/qi ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ContactQueueInfo (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/_switch #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APISwitchGroupMember (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_switch @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APISwitchContact (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_abort switch #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIAbortSwitchGroupMember (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_abort switch @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIAbortSwitchContact (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_sync #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> Bool -> ChatCommand
APISyncGroupMemberRatchet (Int64 -> Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" force=on" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
      Parser ByteString ByteString
"/_sync @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> ChatCommand
APISyncContactRatchet (Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" force=on" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
      Parser ByteString ByteString
"/switch #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> ChatCommand
SwitchGroupMember (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/switch " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
SwitchContact (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/abort switch #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> ChatCommand
AbortSwitchGroupMember (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/abort switch " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
AbortSwitchContact (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/sync #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Bool -> ChatCommand
SyncGroupMemberRatchet (Text -> Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" force=on" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
      Parser ByteString ByteString
"/sync " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Bool -> ChatCommand
SyncContactRatchet (Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" force=on" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
      Parser ByteString ByteString
"/_get code @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIGetContactCode (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_get code #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIGetGroupMemberCode (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_verify code @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Maybe Text -> ChatCommand
APIVerifyContact (Int64 -> Maybe Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
verifyCodeP)),
      Parser ByteString ByteString
"/_verify code #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> Maybe Text -> ChatCommand
APIVerifyGroupMember (Int64 -> Int64 -> Maybe Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> Maybe Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> Maybe Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> Maybe Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
verifyCodeP)),
      Parser ByteString ByteString
"/_enable @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIEnableContact (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_enable #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIEnableGroupMember (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/code " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
GetContactCode (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/code #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> ChatCommand
GetGroupMemberCode (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/verify " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> ChatCommand
VerifyContact (Text -> Maybe Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
verifyCodeP)),
      Parser ByteString ByteString
"/verify #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Maybe Text -> ChatCommand
VerifyGroupMember (Text -> Text -> Maybe Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Maybe Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Maybe Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> Maybe Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> Maybe Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
verifyCodeP)),
      Parser ByteString ByteString
"/enable " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
EnableContact (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/enable #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> ChatCommand
EnableGroupMember (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/help files" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/help file" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hf") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSFiles,
      (Parser ByteString ByteString
"/help groups" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/help group" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hg") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSGroups,
      (Parser ByteString ByteString
"/help contacts" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/help contact" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hc") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSContacts,
      (Parser ByteString ByteString
"/help address" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/ha") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSMyAddress,
      (Parser ByteString ByteString
"/help incognito" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hi") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSIncognito,
      (Parser ByteString ByteString
"/help messages" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hm") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSMessages,
      (Parser ByteString ByteString
"/help remote" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hr") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSRemote,
      (Parser ByteString ByteString
"/help settings" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hs") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSSettings,
      (Parser ByteString ByteString
"/help db" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/hd") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSDatabase,
      (Parser ByteString ByteString
"/help" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/h") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSMain,
      (Parser ByteString ByteString
"/group" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/g") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> GroupProfile -> ChatCommand
NewGroup (Bool -> GroupProfile -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (GroupProfile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
incognitoP Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (GroupProfile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (GroupProfile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString GroupProfile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupProfile
groupProfile),
      Parser ByteString ByteString
"/_group " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> GroupProfile -> ChatCommand
APINewGroup (Int64 -> Bool -> GroupProfile -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> GroupProfile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> GroupProfile -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (GroupProfile -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
incognitoOnOffP Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (GroupProfile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString GroupProfile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupProfile
forall a. FromJSON a => Parser a
jsonP),
      (Parser ByteString ByteString
"/add " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/a ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> GroupMemberRole -> ChatCommand
AddMember (Text -> Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString GroupMemberRole
memberRole Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GroupMemberRole -> Parser ByteString GroupMemberRole
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMemberRole
GRMember)),
      (Parser ByteString ByteString
"/join " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/j ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> MsgFilter -> ChatCommand
JoinGroup (Text -> MsgFilter -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (MsgFilter -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (MsgFilter -> ChatCommand)
-> Parser ByteString MsgFilter -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" mute" Parser ByteString ByteString
-> MsgFilter -> Parser ByteString MsgFilter
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MsgFilter
MFNone Parser ByteString MsgFilter
-> Parser ByteString MsgFilter -> Parser ByteString MsgFilter
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MsgFilter -> Parser ByteString MsgFilter
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MsgFilter
MFAll)),
      Parser ByteString ByteString
"/accept member " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> GroupMemberRole -> ChatCommand
AcceptMember (Text -> Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString GroupMemberRole
memberRole Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GroupMemberRole -> Parser ByteString GroupMemberRole
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMemberRole
GRMember)),
      (Parser ByteString ByteString
"/member role " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/mr ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> GroupMemberRole -> ChatCommand
MemberRole (Text -> Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/block for all #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Bool -> ChatCommand
BlockForAll (Text -> Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayNameP) Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True),
      Parser ByteString ByteString
"/unblock for all #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Bool -> ChatCommand
BlockForAll (Text -> Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayNameP) Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False),
      (Parser ByteString ByteString
"/remove " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/rm ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> NonEmpty Text -> Bool -> ChatCommand
RemoveMembers (Text -> NonEmpty Text -> Bool -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (NonEmpty Text -> Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (NonEmpty Text -> Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (NonEmpty Text -> Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (NonEmpty Text -> Bool -> ChatCommand)
-> Parser ByteString (NonEmpty Text)
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Text] -> NonEmpty Text
forall a. HasCallStack => [a] -> NonEmpty a
L.fromList ([Text] -> NonEmpty Text)
-> Parser ByteString [Text] -> Parser ByteString (NonEmpty Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayNameP) Parser ByteString Text
-> Parser ByteString Char -> Parser ByteString [Text]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy1'` Char -> Parser ByteString Char
A.char Char
',') Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" messages=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)),
      (Parser ByteString ByteString
"/leave " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/l ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
LeaveGroup (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/delete #" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/d #") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
DeleteGroup (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/delete " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/d ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatDeleteMode -> ChatCommand
DeleteContact (Text -> ChatDeleteMode -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (ChatDeleteMode -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (ChatDeleteMode -> ChatCommand)
-> Parser ByteString ChatDeleteMode
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatDeleteMode
chatDeleteMode),
      Parser ByteString ByteString
"/clear *" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ClearNoteFolder,
      Parser ByteString ByteString
"/clear #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ClearGroup (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/clear " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ClearContact (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/members " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/ms ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ListMembers (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/member support chats #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ListMemberSupportChats (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/_groups" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Maybe Int64 -> Maybe Text -> ChatCommand
APIListGroups (Int64 -> Maybe Int64 -> Maybe Text -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe Int64 -> Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe Int64 -> Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Int64)
-> Parser ByteString (Maybe Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" @" Parser ByteString ByteString
-> Parser ByteString Int64 -> Parser ByteString Int64
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal) Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP)),
      (Parser ByteString ByteString
"/groups" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/gs") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe Text -> Maybe Text -> ChatCommand
ListGroups (Maybe Text -> Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" @" Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
displayNameP) Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP)),
      Parser ByteString ByteString
"/_group_profile #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> GroupProfile -> ChatCommand
APIUpdateGroupProfile (Int64 -> GroupProfile -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (GroupProfile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (GroupProfile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString GroupProfile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupProfile
forall a. FromJSON a => Parser a
jsonP),
      (Parser ByteString ByteString
"/group_profile " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/gp ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> GroupProfile -> ChatCommand
UpdateGroupNames (Text -> GroupProfile -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupProfile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (GroupProfile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (GroupProfile -> ChatCommand)
-> Parser ByteString GroupProfile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupProfile
groupProfile),
      (Parser ByteString ByteString
"/group_profile " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/gp ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ShowGroupProfile (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/group_descr " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> ChatCommand
UpdateGroupDescription (Text -> Maybe Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
msgTextP)),
      Parser ByteString ByteString
"/set welcome " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> ChatCommand
UpdateGroupDescription (Text -> Maybe Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
msgTextP)),
      Parser ByteString ByteString
"/delete welcome " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> ChatCommand
UpdateGroupDescription (Text -> Maybe Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser ByteString (Maybe Text)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing),
      Parser ByteString ByteString
"/show welcome " Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'#' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ShowGroupDescription (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/_create link #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> GroupMemberRole -> ChatCommand
APICreateGroupLink (Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString GroupMemberRole
memberRole Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GroupMemberRole -> Parser ByteString GroupMemberRole
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMemberRole
GRMember)),
      Parser ByteString ByteString
"/_set link role #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> GroupMemberRole -> ChatCommand
APIGroupLinkMemberRole (Int64 -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/_delete link #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIDeleteGroupLink (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_get link #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIGetGroupLink (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_short link #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIAddGroupShortLink (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/create link #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> GroupMemberRole -> ChatCommand
CreateGroupLink (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString GroupMemberRole
memberRole Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
-> Parser ByteString GroupMemberRole
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GroupMemberRole -> Parser ByteString GroupMemberRole
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupMemberRole
GRMember)),
      Parser ByteString ByteString
"/set link role #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> GroupMemberRole -> ChatCommand
GroupLinkMemberRole (Text -> GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupMemberRole
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/delete link #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
DeleteGroupLink (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/show link #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
ShowGroupLink (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/_create member contact #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APICreateMemberContact (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_invite member contact @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Maybe MsgContent -> ChatCommand
APISendMemberContactInvitation (Int64 -> Maybe MsgContent -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe MsgContent -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe MsgContent -> ChatCommand)
-> Parser ByteString (Maybe MsgContent)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString MsgContent
-> Parser ByteString (Maybe MsgContent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString MsgContent -> Parser ByteString MsgContent
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgContent
msgContentP)),
      Parser ByteString ByteString
"/_accept member contact @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIAcceptMemberContact (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
">#" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"> #") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> Text -> Text -> ChatCommand
SendGroupMessageQuote (Text -> Maybe Text -> Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser ByteString (Maybe Text)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
quotedMsg Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP),
      (Parser ByteString ByteString
">#" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"> #") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Text -> Text -> Text -> ChatCommand
SendGroupMessageQuote (Text -> Maybe Text -> Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Text -> Text -> Text -> ChatCommand)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP) Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
quotedMsg Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP),
      Parser ByteString ByteString
"/_contacts " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIListContacts (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/contacts" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ListContacts,
      Parser ByteString ByteString
"/_connect plan " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Maybe AConnectionLink -> ChatCommand
APIConnectPlan (Int64 -> Maybe AConnectionLink -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe AConnectionLink -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe AConnectionLink -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe AConnectionLink -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe AConnectionLink -> ChatCommand)
-> Parser ByteString (Maybe AConnectionLink)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((AConnectionLink -> Maybe AConnectionLink
forall a. a -> Maybe a
Just (AConnectionLink -> Maybe AConnectionLink)
-> Parser ByteString AConnectionLink
-> Parser ByteString (Maybe AConnectionLink)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AConnectionLink
forall a. StrEncoding a => Parser a
strP) Parser ByteString (Maybe AConnectionLink)
-> Parser ByteString (Maybe AConnectionLink)
-> Parser ByteString (Maybe AConnectionLink)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString ByteString
-> Maybe AConnectionLink
-> Parser ByteString (Maybe AConnectionLink)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe AConnectionLink
forall a. Maybe a
Nothing)),
      Parser ByteString ByteString
"/_prepare contact " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ACreatedConnLink -> ContactShortLinkData -> ChatCommand
APIPrepareContact (Int64 -> ACreatedConnLink -> ContactShortLinkData -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString
     (ACreatedConnLink -> ContactShortLinkData -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser
  ByteString
  (ACreatedConnLink -> ContactShortLinkData -> ChatCommand)
-> Parser ByteString Char
-> Parser
     ByteString
     (ACreatedConnLink -> ContactShortLinkData -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser
  ByteString
  (ACreatedConnLink -> ContactShortLinkData -> ChatCommand)
-> Parser ByteString ACreatedConnLink
-> Parser ByteString (ContactShortLinkData -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ACreatedConnLink
connLinkP Parser ByteString (ContactShortLinkData -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ContactShortLinkData -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ContactShortLinkData -> ChatCommand)
-> Parser ByteString ContactShortLinkData
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ContactShortLinkData
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_prepare group " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> CreatedLinkContact -> GroupShortLinkData -> ChatCommand
APIPrepareGroup (Int64 -> CreatedLinkContact -> GroupShortLinkData -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString
     (CreatedLinkContact -> GroupShortLinkData -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser
  ByteString
  (CreatedLinkContact -> GroupShortLinkData -> ChatCommand)
-> Parser ByteString Char
-> Parser
     ByteString
     (CreatedLinkContact -> GroupShortLinkData -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser
  ByteString
  (CreatedLinkContact -> GroupShortLinkData -> ChatCommand)
-> Parser ByteString CreatedLinkContact
-> Parser ByteString (GroupShortLinkData -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CreatedLinkContact
connLinkP' Parser ByteString (GroupShortLinkData -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (GroupShortLinkData -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (GroupShortLinkData -> ChatCommand)
-> Parser ByteString GroupShortLinkData
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupShortLinkData
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/_set contact user @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIChangePreparedContactUser (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_set group user #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIChangePreparedGroupUser (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_connect contact @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> Maybe MsgContent -> ChatCommand
APIConnectPreparedContact (Int64 -> Bool -> Maybe MsgContent -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> Maybe MsgContent -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> Maybe MsgContent -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Maybe MsgContent -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
incognitoOnOffP Parser ByteString (Maybe MsgContent -> ChatCommand)
-> Parser ByteString (Maybe MsgContent)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString MsgContent
-> Parser ByteString (Maybe MsgContent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString MsgContent -> Parser ByteString MsgContent
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgContent
msgContentP)),
      Parser ByteString ByteString
"/_connect group #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> Maybe MsgContent -> ChatCommand
APIConnectPreparedGroup (Int64 -> Bool -> Maybe MsgContent -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> Maybe MsgContent -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> Maybe MsgContent -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Maybe MsgContent -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
incognitoOnOffP Parser ByteString (Maybe MsgContent -> ChatCommand)
-> Parser ByteString (Maybe MsgContent)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString MsgContent
-> Parser ByteString (Maybe MsgContent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString MsgContent -> Parser ByteString MsgContent
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgContent
msgContentP)),
      Parser ByteString ByteString
"/_connect " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> ChatCommand
APIAddContact (Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
incognitoOnOffP),
      Parser ByteString ByteString
"/_connect " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> Maybe ACreatedConnLink -> ChatCommand
APIConnect (Int64 -> Bool -> Maybe ACreatedConnLink -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString (Bool -> Maybe ACreatedConnLink -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> Maybe ACreatedConnLink -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Maybe ACreatedConnLink -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
incognitoOnOffP Parser ByteString (Maybe ACreatedConnLink -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe ACreatedConnLink -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe ACreatedConnLink -> ChatCommand)
-> Parser ByteString (Maybe ACreatedConnLink)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe ACreatedConnLink)
connLinkP_),
      Parser ByteString ByteString
"/_set incognito :" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> ChatCommand
APISetConnectionIncognito (Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/_set conn user :" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Int64 -> ChatCommand
APIChangeConnectionUser (Int64 -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/connect" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/c") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
AddContact (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
incognitoP),
      (Parser ByteString ByteString
"/connect" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/c") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> Maybe AConnectionLink -> ChatCommand
Connect (Bool -> Maybe AConnectionLink -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Maybe AConnectionLink -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
incognitoP Parser ByteString (Maybe AConnectionLink -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe AConnectionLink -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe AConnectionLink -> ChatCommand)
-> Parser ByteString (Maybe AConnectionLink)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((AConnectionLink -> Maybe AConnectionLink
forall a. a -> Maybe a
Just (AConnectionLink -> Maybe AConnectionLink)
-> Parser ByteString AConnectionLink
-> Parser ByteString (Maybe AConnectionLink)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AConnectionLink
forall a. StrEncoding a => Parser a
strP) Parser ByteString (Maybe AConnectionLink)
-> Parser ByteString (Maybe AConnectionLink)
-> Parser ByteString (Maybe AConnectionLink)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill Char -> Bool
isSpace Parser ByteString ByteString
-> Maybe AConnectionLink
-> Parser ByteString (Maybe AConnectionLink)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe AConnectionLink
forall a. Maybe a
Nothing)),
      ChatName -> Text -> Text -> ChatCommand
ForwardMessage (ChatName -> Text -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" <- @" Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP,
      ChatName -> Text -> Maybe Text -> Text -> ChatCommand
ForwardGroupMessage (ChatName -> Text -> Maybe Text -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" <- #" Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Maybe Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Maybe Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
'@' Parser ByteString (Maybe Text -> Text -> ChatCommand)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP) Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP,
      ChatName -> Text -> Maybe Text -> Text -> ChatCommand
ForwardGroupMessage (ChatName -> Text -> Maybe Text -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" <- #" Parser ByteString (Text -> Maybe Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> Text -> ChatCommand)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser ByteString (Maybe Text)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP,
      ChatName -> Text -> ChatCommand
ForwardLocalMessage (ChatName -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString ByteString
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
" <- * " Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP,
      SendName -> Text -> ChatCommand
SendMessage (SendName -> Text -> ChatCommand)
-> Parser ByteString SendName
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SendName
sendNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP,
      Parser ByteString ByteString
"@#" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Text -> ChatCommand
SendMemberContactMessage (Text -> Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP),
      Parser ByteString ByteString
"/accept_member_contact @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
AcceptMemberContact (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      Parser ByteString ByteString
"/live " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Text -> ChatCommand
SendLiveMessage (ChatName -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
msgTextP Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"")),
      (Parser ByteString ByteString
">@" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"> @") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AMsgDirection -> Parser ByteString ChatCommand
sendMsgQuote (SMsgDirection 'MDRcv -> AMsgDirection
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> AMsgDirection
AMsgDirection SMsgDirection 'MDRcv
SMDRcv),
      (Parser ByteString ByteString
">>@" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
">> @") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> AMsgDirection -> Parser ByteString ChatCommand
sendMsgQuote (SMsgDirection 'MDSnd -> AMsgDirection
forall (d :: MsgDirection).
MsgDirectionI d =>
SMsgDirection d -> AMsgDirection
AMsgDirection SMsgDirection 'MDSnd
SMDSnd),
      (Parser ByteString ByteString
"\\ " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"\\") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Text -> ChatCommand
DeleteMessage (ChatName -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
textP),
      (Parser ByteString ByteString
"\\\\ #" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"\\\\#") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Text -> ChatCommand
DeleteMemberMessage (Text -> Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
textP),
      (Parser ByteString ByteString
"! " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"!") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Text -> Text -> ChatCommand
EditMessage (ChatName -> Text -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Text
quotedMsg Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"") Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP),
      Bool -> MsgReaction -> ChatName -> Text -> ChatCommand
ReactToMessage (Bool -> MsgReaction -> ChatName -> Text -> ChatCommand)
-> Parser ByteString Bool
-> Parser
     ByteString (MsgReaction -> ChatName -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser ByteString ByteString
"+" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"-" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)) Parser ByteString (MsgReaction -> ChatName -> Text -> ChatCommand)
-> Parser ByteString MsgReaction
-> Parser ByteString (ChatName -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString MsgReaction
reactionP Parser ByteString (ChatName -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (ChatName -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (ChatName -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ChatName
chatNameP' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
textP,
      Parser ByteString ByteString
"/feed " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (MsgContent -> ChatCommand
SendMessageBroadcast (MsgContent -> ChatCommand)
-> (Text -> MsgContent) -> Text -> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MsgContent
MCText (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
msgTextP),
      (Parser ByteString ByteString
"/chats" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/cs") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe Int -> ChatCommand
LastChats (Maybe Int -> ChatCommand)
-> Parser ByteString (Maybe Int) -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" all" Parser ByteString ByteString
-> Maybe Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Int
forall a. Maybe a
Nothing Parser ByteString (Maybe Int)
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
20))),
      (Parser ByteString ByteString
"/tail" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/t") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe ChatName -> Int -> Maybe Text -> ChatCommand
LastMessages (Maybe ChatName -> Int -> Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe ChatName)
-> Parser ByteString (Int -> Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName -> Parser ByteString (Maybe ChatName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString ChatName -> Parser ByteString ChatName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ChatName
chatNameP) Parser ByteString (Int -> Maybe Text -> ChatCommand)
-> Parser ByteString Int
-> Parser ByteString (Maybe Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
msgCountP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> Parser ByteString (Maybe Text)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing),
      (Parser ByteString ByteString
"/search" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/?") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe ChatName -> Int -> Maybe Text -> ChatCommand
LastMessages (Maybe ChatName -> Int -> Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe ChatName)
-> Parser ByteString (Int -> Maybe Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName -> Parser ByteString (Maybe ChatName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString ChatName -> Parser ByteString ChatName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ChatName
chatNameP) Parser ByteString (Int -> Maybe Text -> ChatCommand)
-> Parser ByteString Int
-> Parser ByteString (Maybe Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
msgCountP Parser ByteString (Maybe Text -> ChatCommand)
-> Parser ByteString (Maybe Text) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Text
textP))),
      Parser ByteString ByteString
"/last_item_id" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe ChatName -> Int -> ChatCommand
LastChatItemId (Maybe ChatName -> Int -> ChatCommand)
-> Parser ByteString (Maybe ChatName)
-> Parser ByteString (Int -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName -> Parser ByteString (Maybe ChatName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString ChatName -> Parser ByteString ChatName
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ChatName
chatNameP) Parser ByteString (Int -> ChatCommand)
-> Parser ByteString Int -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0)),
      Parser ByteString ByteString
"/show" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
ShowLiveItems (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)),
      Parser ByteString ByteString
"/show " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe Int64 -> ChatCommand
ShowChatItem (Maybe Int64 -> ChatCommand)
-> (Int64 -> Maybe Int64) -> Int64 -> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/item info " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Text -> ChatCommand
ShowChatItemInfo (ChatName -> Text -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP),
      (Parser ByteString ByteString
"/file " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/f ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> CryptoFile -> ChatCommand
SendFile (ChatName -> CryptoFile -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (CryptoFile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP' Parser ByteString (CryptoFile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (CryptoFile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (CryptoFile -> ChatCommand)
-> Parser ByteString CryptoFile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CryptoFile
cryptoFileP),
      (Parser ByteString ByteString
"/image " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/img ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> CryptoFile -> ChatCommand
SendImage (ChatName -> CryptoFile -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (CryptoFile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP' Parser ByteString (CryptoFile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (CryptoFile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (CryptoFile -> ChatCommand)
-> Parser ByteString CryptoFile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CryptoFile
cryptoFileP),
      (Parser ByteString ByteString
"/fforward " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/ff ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Int64 -> ChatCommand
ForwardFile (ChatName -> Int64 -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP' Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/image_forward " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/imgf ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> Int64 -> ChatCommand
ForwardImage (ChatName -> Int64 -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP' Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/fdescription " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/fd") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatName -> String -> ChatCommand
SendFileDescription (ChatName -> String -> ChatCommand)
-> Parser ByteString ChatName
-> Parser ByteString (String -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatName
chatNameP' Parser ByteString (String -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (String -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (String -> ChatCommand)
-> Parser ByteString String -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString String
filePath),
      (Parser ByteString ByteString
"/freceive " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/fr ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64
-> Bool -> Maybe Bool -> Maybe Bool -> Maybe String -> ChatCommand
ReceiveFile (Int64
 -> Bool -> Maybe Bool -> Maybe Bool -> Maybe String -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString
     (Bool -> Maybe Bool -> Maybe Bool -> Maybe String -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser
  ByteString
  (Bool -> Maybe Bool -> Maybe Bool -> Maybe String -> ChatCommand)
-> Parser ByteString Bool
-> Parser
     ByteString
     (Maybe Bool -> Maybe Bool -> Maybe String -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" approved_relays=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser
  ByteString
  (Maybe Bool -> Maybe Bool -> Maybe String -> ChatCommand)
-> Parser ByteString (Maybe Bool)
-> Parser ByteString (Maybe Bool -> Maybe String -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" encrypt=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP) Parser ByteString (Maybe Bool -> Maybe String -> ChatCommand)
-> Parser ByteString (Maybe Bool)
-> Parser ByteString (Maybe String -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" inline=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP) Parser ByteString (Maybe String -> ChatCommand)
-> Parser ByteString (Maybe String)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString String -> Parser ByteString (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString String -> Parser ByteString String
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString String
filePath)),
      Parser ByteString ByteString
"/_set_file_to_receive " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> Maybe Bool -> ChatCommand
SetFileToReceive (Int64 -> Bool -> Maybe Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> Maybe Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> Maybe Bool -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Maybe Bool -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" approved_relays=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) Parser ByteString (Maybe Bool -> ChatCommand)
-> Parser ByteString (Maybe Bool) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" encrypt=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP)),
      (Parser ByteString ByteString
"/fcancel " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/fc ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
CancelFile (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/fstatus " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/fs ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
FileStatus (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_connect contact " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> Int64 -> ChatCommand
APIConnectContactViaAddress (Int64 -> Bool -> Int64 -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> Int64 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> Int64 -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
incognitoOnOffP Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Int64 -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/simplex" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
ConnectSimplex (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
incognitoP),
      Parser ByteString ByteString
"/_address " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APICreateMyAddress (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/address" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/ad") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
CreateMyAddress,
      Parser ByteString ByteString
"/_delete_address " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIDeleteMyAddress (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/delete_address" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/da") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
DeleteMyAddress,
      Parser ByteString ByteString
"/_show_address " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIShowMyAddress (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      (Parser ByteString ByteString
"/show_address" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/sa") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ShowMyAddress,
      Parser ByteString ByteString
"/_short_link_address " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
APIAddMyAddressShortLink (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_profile_address " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Bool -> ChatCommand
APISetProfileAddress (Int64 -> Bool -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Bool -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Bool -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool
onOffP),
      (Parser ByteString ByteString
"/profile_address " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/pa ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
SetProfileAddress (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
onOffP),
      Parser ByteString ByteString
"/_address_settings " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> AddressSettings -> ChatCommand
APISetAddressSettings (Int64 -> AddressSettings -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (AddressSettings -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (AddressSettings -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (AddressSettings -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (AddressSettings -> ChatCommand)
-> Parser ByteString AddressSettings
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString AddressSettings
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/auto_accept " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AddressSettings -> ChatCommand
SetAddressSettings (AddressSettings -> ChatCommand)
-> Parser ByteString AddressSettings
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString AddressSettings
autoAcceptP),
      (Parser ByteString ByteString
"/accept" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/ac") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> Text -> ChatCommand
AcceptContact (Bool -> Text -> ChatCommand)
-> Parser ByteString Bool
-> Parser ByteString (Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
incognitoP Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Text -> ChatCommand)
-> Parser ByteString (Maybe Char)
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/reject " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/rc ") Parser ByteString ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString (Maybe Char)
char_ Char
'@' Parser ByteString (Maybe Char)
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
RejectContact (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP),
      (Parser ByteString ByteString
"/markdown" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/m") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSMarkdown,
      (Parser ByteString ByteString
"/welcome" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/w") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
Welcome,
      Parser ByteString ByteString
"/set profile image " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe ImageData -> ChatCommand
UpdateProfileImage (Maybe ImageData -> ChatCommand)
-> (Text -> Maybe ImageData) -> Text -> ChatCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImageData -> Maybe ImageData
forall a. a -> Maybe a
Just (ImageData -> Maybe ImageData)
-> (Text -> ImageData) -> Text -> Maybe ImageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ImageData
ImageData (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
imageP),
      Parser ByteString ByteString
"/delete profile image" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe ImageData -> ChatCommand
UpdateProfileImage Maybe ImageData
forall a. Maybe a
Nothing,
      Parser ByteString ByteString
"/show profile image" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ShowProfileImage,
      (Parser ByteString ByteString
"/profile " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/p ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Text -> Maybe Text -> ChatCommand)
-> (Text, Maybe Text) -> ChatCommand
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Maybe Text -> ChatCommand
UpdateProfile ((Text, Maybe Text) -> ChatCommand)
-> Parser ByteString (Text, Maybe Text)
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Text, Maybe Text)
profileNameDescr),
      (Parser ByteString ByteString
"/profile" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/p") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ShowProfile,
      Parser ByteString ByteString
"/set bot commands " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([ChatBotCommand] -> ChatCommand
SetBotCommands ([ChatBotCommand] -> ChatCommand)
-> Parser ByteString [ChatBotCommand]
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ChatBotCommand]
botCommandsP),
      Parser ByteString ByteString
"/delete bot commands" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [ChatBotCommand] -> ChatCommand
SetBotCommands [],
      Parser ByteString ByteString
"/set voice #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureRole
-> Text
-> GroupFeatureEnabled
-> Maybe GroupMemberRole
-> ChatCommand
SetGroupFeatureRole (SGroupFeature 'GFVoice -> AGroupFeatureRole
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> AGroupFeatureRole
AGFR SGroupFeature 'GFVoice
SGFVoice) (Text
 -> GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser
     ByteString
     (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser
  ByteString
  (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe GroupMemberRole)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
-> Parser ByteString (Maybe GroupMemberRole)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/set voice @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> Text -> Maybe FeatureAllowed -> ChatCommand
SetContactFeature (SChatFeature 'CFVoice -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFVoice
SCFVoice) (Text -> Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString (Maybe FeatureAllowed)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString FeatureAllowed
-> Parser ByteString (Maybe FeatureAllowed)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString FeatureAllowed
-> Parser ByteString FeatureAllowed
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP)),
      Parser ByteString ByteString
"/set voice " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> FeatureAllowed -> ChatCommand
SetUserFeature (SChatFeature 'CFVoice -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFVoice
SCFVoice) (FeatureAllowed -> ChatCommand)
-> Parser ByteString FeatureAllowed
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/set files #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureRole
-> Text
-> GroupFeatureEnabled
-> Maybe GroupMemberRole
-> ChatCommand
SetGroupFeatureRole (SGroupFeature 'GFFiles -> AGroupFeatureRole
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> AGroupFeatureRole
AGFR SGroupFeature 'GFFiles
SGFFiles) (Text
 -> GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser
     ByteString
     (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser
  ByteString
  (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe GroupMemberRole)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
-> Parser ByteString (Maybe GroupMemberRole)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/set files @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> Text -> Maybe FeatureAllowed -> ChatCommand
SetContactFeature (SChatFeature 'CFFiles -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFFiles
SCFFiles) (Text -> Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString (Maybe FeatureAllowed)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString FeatureAllowed
-> Parser ByteString (Maybe FeatureAllowed)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString FeatureAllowed
-> Parser ByteString FeatureAllowed
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP)),
      Parser ByteString ByteString
"/set files " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> FeatureAllowed -> ChatCommand
SetUserFeature (SChatFeature 'CFFiles -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFFiles
SCFFiles) (FeatureAllowed -> ChatCommand)
-> Parser ByteString FeatureAllowed
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/set history #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureNoRole -> Text -> GroupFeatureEnabled -> ChatCommand
SetGroupFeature (SGroupFeature 'GFHistory -> AGroupFeatureNoRole
forall (f :: GroupFeature).
GroupFeatureNoRoleI f =>
SGroupFeature f -> AGroupFeatureNoRole
AGFNR SGroupFeature 'GFHistory
SGFHistory) (Text -> GroupFeatureEnabled -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupFeatureEnabled -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (GroupFeatureEnabled -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString GroupFeatureEnabled
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
strP)),
      Parser ByteString ByteString
"/set reactions #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureNoRole -> Text -> GroupFeatureEnabled -> ChatCommand
SetGroupFeature (SGroupFeature 'GFReactions -> AGroupFeatureNoRole
forall (f :: GroupFeature).
GroupFeatureNoRoleI f =>
SGroupFeature f -> AGroupFeatureNoRole
AGFNR SGroupFeature 'GFReactions
SGFReactions) (Text -> GroupFeatureEnabled -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupFeatureEnabled -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (GroupFeatureEnabled -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString GroupFeatureEnabled
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
strP)),
      Parser ByteString ByteString
"/set calls @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> Text -> Maybe FeatureAllowed -> ChatCommand
SetContactFeature (SChatFeature 'CFCalls -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFCalls
SCFCalls) (Text -> Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString (Maybe FeatureAllowed)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString FeatureAllowed
-> Parser ByteString (Maybe FeatureAllowed)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString FeatureAllowed
-> Parser ByteString FeatureAllowed
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP)),
      Parser ByteString ByteString
"/set calls " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> FeatureAllowed -> ChatCommand
SetUserFeature (SChatFeature 'CFCalls -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFCalls
SCFCalls) (FeatureAllowed -> ChatCommand)
-> Parser ByteString FeatureAllowed
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/set delete #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureRole
-> Text
-> GroupFeatureEnabled
-> Maybe GroupMemberRole
-> ChatCommand
SetGroupFeatureRole (SGroupFeature 'GFFullDelete -> AGroupFeatureRole
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> AGroupFeatureRole
AGFR SGroupFeature 'GFFullDelete
SGFFullDelete) (Text
 -> GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser
     ByteString
     (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser
  ByteString
  (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe GroupMemberRole)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
-> Parser ByteString (Maybe GroupMemberRole)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/set delete @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> Text -> Maybe FeatureAllowed -> ChatCommand
SetContactFeature (SChatFeature 'CFFullDelete -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFFullDelete
SCFFullDelete) (Text -> Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe FeatureAllowed -> ChatCommand)
-> Parser ByteString (Maybe FeatureAllowed)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString FeatureAllowed
-> Parser ByteString (Maybe FeatureAllowed)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString FeatureAllowed
-> Parser ByteString FeatureAllowed
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP)),
      Parser ByteString ByteString
"/set delete " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AChatFeature -> FeatureAllowed -> ChatCommand
SetUserFeature (SChatFeature 'CFFullDelete -> AChatFeature
forall (f :: ChatFeature).
FeatureI f =>
SChatFeature f -> AChatFeature
ACF SChatFeature 'CFFullDelete
SCFFullDelete) (FeatureAllowed -> ChatCommand)
-> Parser ByteString FeatureAllowed
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString FeatureAllowed
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/set direct #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureRole
-> Text
-> GroupFeatureEnabled
-> Maybe GroupMemberRole
-> ChatCommand
SetGroupFeatureRole (SGroupFeature 'GFDirectMessages -> AGroupFeatureRole
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> AGroupFeatureRole
AGFR SGroupFeature 'GFDirectMessages
SGFDirectMessages) (Text
 -> GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser
     ByteString
     (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser
  ByteString
  (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe GroupMemberRole)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
-> Parser ByteString (Maybe GroupMemberRole)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/set disappear #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe Int -> ChatCommand
SetGroupTimedMessages (Text -> Maybe Int -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe Int -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Int -> ChatCommand)
-> Parser ByteString (Maybe Int) -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Maybe Int)
timedTTLOnOffP)),
      Parser ByteString ByteString
"/set disappear @" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe TimedMessagesEnabled -> ChatCommand
SetContactTimedMessages (Text -> Maybe TimedMessagesEnabled -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe TimedMessagesEnabled -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe TimedMessagesEnabled -> ChatCommand)
-> Parser ByteString (Maybe TimedMessagesEnabled)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString TimedMessagesEnabled
-> Parser ByteString (Maybe TimedMessagesEnabled)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString TimedMessagesEnabled
-> Parser ByteString TimedMessagesEnabled
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString TimedMessagesEnabled
timedMessagesEnabledP)),
      Parser ByteString ByteString
"/set disappear " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatCommand
SetUserTimedMessages (Bool -> ChatCommand)
-> Parser ByteString Bool -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser ByteString ByteString
"yes" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"no" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False))),
      Parser ByteString ByteString
"/set reports #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureNoRole -> Text -> GroupFeatureEnabled -> ChatCommand
SetGroupFeature (SGroupFeature 'GFReports -> AGroupFeatureNoRole
forall (f :: GroupFeature).
GroupFeatureNoRoleI f =>
SGroupFeature f -> AGroupFeatureNoRole
AGFNR SGroupFeature 'GFReports
SGFReports) (Text -> GroupFeatureEnabled -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (GroupFeatureEnabled -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (GroupFeatureEnabled -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
_strP),
      Parser ByteString ByteString
"/set links #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AGroupFeatureRole
-> Text
-> GroupFeatureEnabled
-> Maybe GroupMemberRole
-> ChatCommand
SetGroupFeatureRole (SGroupFeature 'GFSimplexLinks -> AGroupFeatureRole
forall (f :: GroupFeature).
GroupFeatureRoleI f =>
SGroupFeature f -> AGroupFeatureRole
AGFR SGroupFeature 'GFSimplexLinks
SGFSimplexLinks) (Text
 -> GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString Text
-> Parser
     ByteString
     (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser
  ByteString
  (GroupFeatureEnabled -> Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString GroupFeatureEnabled
-> Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupFeatureEnabled
forall a. StrEncoding a => Parser a
_strP Parser ByteString (Maybe GroupMemberRole -> ChatCommand)
-> Parser ByteString (Maybe GroupMemberRole)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupMemberRole
-> Parser ByteString (Maybe GroupMemberRole)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString GroupMemberRole
memberRole),
      Parser ByteString ByteString
"/set admission review #" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Maybe MemberCriteria -> ChatCommand
SetGroupMemberAdmissionReview (Text -> Maybe MemberCriteria -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Maybe MemberCriteria -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe MemberCriteria -> ChatCommand)
-> Parser ByteString (Maybe MemberCriteria)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString (Maybe MemberCriteria)
-> Parser ByteString (Maybe MemberCriteria)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (Maybe MemberCriteria)
memberCriteriaP)),
      (Parser ByteString ByteString
"/incognito" Parser ByteString ByteString
-> Parser ByteString (Maybe Bool) -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP)) Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> HelpSection -> ChatCommand
ChatHelp HelpSection
HSIncognito,
      Parser ByteString ByteString
"/set device name " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
SetLocalDeviceName (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
textP),
      Parser ByteString ByteString
"/list remote hosts" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ListRemoteHosts,
      Parser ByteString ByteString
"/switch remote host " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe Int64 -> ChatCommand
SwitchRemoteHost (Maybe Int64 -> ChatCommand)
-> Parser ByteString (Maybe Int64) -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"local" Parser ByteString ByteString
-> Maybe Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Int64
forall a. Maybe a
Nothing Parser ByteString (Maybe Int64)
-> Parser ByteString (Maybe Int64)
-> Parser ByteString (Maybe Int64)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64)
-> Parser ByteString Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal))),
      Parser ByteString ByteString
"/start remote host " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe (Int64, Bool)
-> Maybe RCCtrlAddress -> Maybe Word16 -> ChatCommand
StartRemoteHost (Maybe (Int64, Bool)
 -> Maybe RCCtrlAddress -> Maybe Word16 -> ChatCommand)
-> Parser ByteString (Maybe (Int64, Bool))
-> Parser
     ByteString (Maybe RCCtrlAddress -> Maybe Word16 -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"new" Parser ByteString ByteString
-> Maybe (Int64, Bool) -> Parser ByteString (Maybe (Int64, Bool))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (Int64, Bool)
forall a. Maybe a
Nothing Parser ByteString (Maybe (Int64, Bool))
-> Parser ByteString (Maybe (Int64, Bool))
-> Parser ByteString (Maybe (Int64, Bool))
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Int64, Bool) -> Maybe (Int64, Bool)
forall a. a -> Maybe a
Just ((Int64, Bool) -> Maybe (Int64, Bool))
-> Parser ByteString (Int64, Bool)
-> Parser ByteString (Maybe (Int64, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Int64 -> Bool -> (Int64, Bool))
-> Parser ByteString Int64
-> Parser ByteString (Bool -> (Int64, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Bool -> (Int64, Bool))
-> Parser ByteString Bool -> Parser ByteString (Int64, Bool)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" multicast=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)))) Parser
  ByteString (Maybe RCCtrlAddress -> Maybe Word16 -> ChatCommand)
-> Parser ByteString (Maybe RCCtrlAddress)
-> Parser ByteString (Maybe Word16 -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString RCCtrlAddress
-> Parser ByteString (Maybe RCCtrlAddress)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString RCCtrlAddress
-> Parser ByteString RCCtrlAddress
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString RCCtrlAddress
rcCtrlAddressP) Parser ByteString (Maybe Word16 -> ChatCommand)
-> Parser ByteString (Maybe Word16)
-> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Word16 -> Parser ByteString (Maybe Word16)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" port=" Parser ByteString ByteString
-> Parser ByteString Word16 -> Parser ByteString Word16
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Word16
forall a. Integral a => Parser a
A.decimal)),
      Parser ByteString ByteString
"/stop remote host " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (RHKey -> ChatCommand
StopRemoteHost (RHKey -> ChatCommand)
-> Parser ByteString RHKey -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"new" Parser ByteString ByteString -> RHKey -> Parser ByteString RHKey
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RHKey
RHNew Parser ByteString RHKey
-> Parser ByteString RHKey -> Parser ByteString RHKey
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int64 -> RHKey
RHId (Int64 -> RHKey)
-> Parser ByteString Int64 -> Parser ByteString RHKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal)),
      Parser ByteString ByteString
"/delete remote host " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
DeleteRemoteHost (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/store remote file " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> Maybe Bool -> String -> ChatCommand
StoreRemoteFile (Int64 -> Maybe Bool -> String -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (Maybe Bool -> String -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe Bool -> String -> ChatCommand)
-> Parser ByteString (Maybe Bool)
-> Parser ByteString (String -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
" encrypt=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP) Parser ByteString (String -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (String -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (String -> ChatCommand)
-> Parser ByteString String -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString String
filePath),
      Parser ByteString ByteString
"/get remote file " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> RemoteFile -> ChatCommand
GetRemoteFile (Int64 -> RemoteFile -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (RemoteFile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (RemoteFile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (RemoteFile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (RemoteFile -> ChatCommand)
-> Parser ByteString RemoteFile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString RemoteFile
forall a. FromJSON a => Parser a
jsonP),
      (Parser ByteString ByteString
"/connect remote ctrl " Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/crc ") Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (RCSignedInvitation -> ChatCommand
ConnectRemoteCtrl (RCSignedInvitation -> ChatCommand)
-> Parser ByteString RCSignedInvitation
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RCSignedInvitation
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/find remote ctrl" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
FindKnownRemoteCtrl,
      Parser ByteString ByteString
"/confirm remote ctrl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
ConfirmRemoteCtrl (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/verify remote ctrl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ChatCommand
VerifyRemoteCtrlSession (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
textP),
      Parser ByteString ByteString
"/list remote ctrls" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ListRemoteCtrls,
      Parser ByteString ByteString
"/stop remote ctrl" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
StopRemoteCtrl,
      Parser ByteString ByteString
"/delete remote ctrl " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
DeleteRemoteCtrl (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/_upload " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> CryptoFile -> ChatCommand
APIUploadStandaloneFile (Int64 -> CryptoFile -> ChatCommand)
-> Parser ByteString Int64
-> Parser ByteString (CryptoFile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (CryptoFile -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (CryptoFile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (CryptoFile -> ChatCommand)
-> Parser ByteString CryptoFile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CryptoFile
cryptoFileP),
      Parser ByteString ByteString
"/_download info " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FileDescriptionURI -> ChatCommand
APIStandaloneFileInfo (FileDescriptionURI -> ChatCommand)
-> Parser ByteString FileDescriptionURI
-> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString FileDescriptionURI
forall a. StrEncoding a => Parser a
strP),
      Parser ByteString ByteString
"/_download " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> FileDescriptionURI -> CryptoFile -> ChatCommand
APIDownloadStandaloneFile (Int64 -> FileDescriptionURI -> CryptoFile -> ChatCommand)
-> Parser ByteString Int64
-> Parser
     ByteString (FileDescriptionURI -> CryptoFile -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (FileDescriptionURI -> CryptoFile -> ChatCommand)
-> Parser ByteString Char
-> Parser
     ByteString (FileDescriptionURI -> CryptoFile -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (FileDescriptionURI -> CryptoFile -> ChatCommand)
-> Parser ByteString FileDescriptionURI
-> Parser ByteString (CryptoFile -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString FileDescriptionURI
forall a. StrEncoding a => Parser a
strP_ Parser ByteString (CryptoFile -> ChatCommand)
-> Parser ByteString CryptoFile -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString CryptoFile
cryptoFileP),
      (Parser ByteString ByteString
"/quit" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/q" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/exit") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
QuitChat,
      (Parser ByteString ByteString
"/version" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"/v") Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ShowVersion,
      Parser ByteString ByteString
"/debug locks" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
DebugLocks,
      Parser ByteString ByteString
"/debug event " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ChatEvent -> ChatCommand
DebugEvent (ChatEvent -> ChatCommand)
-> Parser ByteString ChatEvent -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ChatEvent
forall a. FromJSON a => Parser a
jsonP),
      Parser ByteString ByteString
"/get subs total " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
GetAgentSubsTotal (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/get servers summary " Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int64 -> ChatCommand
GetAgentServersSummary (Int64 -> ChatCommand)
-> Parser ByteString Int64 -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal),
      Parser ByteString ByteString
"/reset servers stats" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
ResetAgentServersStats,
      Parser ByteString ByteString
"/get subs" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
GetAgentSubs,
      Parser ByteString ByteString
"/get subs details" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
GetAgentSubsDetails,
      Parser ByteString ByteString
"/get workers" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
GetAgentWorkers,
      Parser ByteString ByteString
"/get workers details" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
GetAgentWorkersDetails,
      Parser ByteString ByteString
"/get queues" Parser ByteString ByteString
-> ChatCommand -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatCommand
GetAgentQueuesInfo,
      Parser ByteString ByteString
"//" Parser ByteString ByteString
-> Parser ByteString ChatCommand -> Parser ByteString ChatCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> ChatCommand
CustomChatCommand (ByteString -> ChatCommand)
-> Parser ByteString ByteString -> Parser ByteString ChatCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString)
    ]
  where
    choice :: [Parser ByteString a] -> Parser ByteString a
choice = [Parser ByteString a] -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice ([Parser ByteString a] -> Parser ByteString a)
-> ([Parser ByteString a] -> [Parser ByteString a])
-> [Parser ByteString a]
-> Parser ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser ByteString a -> Parser ByteString a)
-> [Parser ByteString a] -> [Parser ByteString a]
forall a b. (a -> b) -> [a] -> [b]
map (\Parser ByteString a
p -> Parser ByteString a
p Parser ByteString a
-> Parser ByteString ByteString -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString a -> Parser ByteString () -> Parser ByteString a
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
A.endOfInput)
    connLinkP :: Parser ByteString ACreatedConnLink
connLinkP = do
      (ACR SConnectionMode m
m ConnectionRequestUri m
cReq) <- Parser AConnectionRequestUri
forall a. StrEncoding a => Parser a
strP
      Maybe (ConnShortLink m)
sLink_ <- Parser ByteString (ConnShortLink m)
-> Parser ByteString (Maybe (ConnShortLink m))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString (ConnShortLink m)
-> Parser ByteString (ConnShortLink m)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (ConnShortLink m)
forall a. StrEncoding a => Parser a
strP)
      ACreatedConnLink -> Parser ByteString ACreatedConnLink
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ACreatedConnLink -> Parser ByteString ACreatedConnLink)
-> ACreatedConnLink -> Parser ByteString ACreatedConnLink
forall a b. (a -> b) -> a -> b
$ SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
forall (m :: ConnectionMode).
ConnectionModeI m =>
SConnectionMode m -> CreatedConnLink m -> ACreatedConnLink
ACCL SConnectionMode m
m (ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnectionRequestUri m
cReq Maybe (ConnShortLink m)
sLink_)
    connLinkP' :: Parser ByteString CreatedLinkContact
connLinkP' = do
      ConnReqContact
cReq <- Parser ConnReqContact
forall a. StrEncoding a => Parser a
strP
      Maybe (ConnShortLink 'CMContact)
sLink_ <- Parser ByteString (ConnShortLink 'CMContact)
-> Parser ByteString (Maybe (ConnShortLink 'CMContact))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString (ConnShortLink 'CMContact)
-> Parser ByteString (ConnShortLink 'CMContact)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString (ConnShortLink 'CMContact)
forall a. StrEncoding a => Parser a
strP)
      CreatedLinkContact -> Parser ByteString CreatedLinkContact
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CreatedLinkContact -> Parser ByteString CreatedLinkContact)
-> CreatedLinkContact -> Parser ByteString CreatedLinkContact
forall a b. (a -> b) -> a -> b
$ ConnReqContact
-> Maybe (ConnShortLink 'CMContact) -> CreatedLinkContact
forall (m :: ConnectionMode).
ConnectionRequestUri m
-> Maybe (ConnShortLink m) -> CreatedConnLink m
CCLink ConnReqContact
cReq Maybe (ConnShortLink 'CMContact)
sLink_
    connLinkP_ :: Parser ByteString (Maybe ACreatedConnLink)
connLinkP_ =
      ((ACreatedConnLink -> Maybe ACreatedConnLink
forall a. a -> Maybe a
Just (ACreatedConnLink -> Maybe ACreatedConnLink)
-> Parser ByteString ACreatedConnLink
-> Parser ByteString (Maybe ACreatedConnLink)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ACreatedConnLink
connLinkP) Parser ByteString (Maybe ACreatedConnLink)
-> Parser ByteString (Maybe ACreatedConnLink)
-> Parser ByteString (Maybe ACreatedConnLink)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString ByteString
-> Maybe ACreatedConnLink
-> Parser ByteString (Maybe ACreatedConnLink)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe ACreatedConnLink
forall a. Maybe a
Nothing)
    incognitoP :: Parser ByteString Bool
incognitoP = (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString ByteString
"incognito" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"i")) Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    incognitoOnOffP :: Parser ByteString Bool
incognitoOnOffP = (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"incognito=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    imagePrefix :: Parser ByteString ByteString
imagePrefix = ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) (ByteString -> ByteString -> ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
"data:" Parser ByteString (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
"image/png;base64," Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"image/jpg;base64,")
    imageP :: Parser ByteString Text
imageP = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) (ByteString -> ByteString -> ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
imagePrefix Parser ByteString (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
base64P))
    chatTypeP :: Parser ByteString ChatType
chatTypeP = Char -> Parser ByteString Char
A.char Char
'@' Parser ByteString Char -> ChatType -> Parser ByteString ChatType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatType
CTDirect Parser ByteString ChatType
-> Parser ByteString ChatType -> Parser ByteString ChatType
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
'#' Parser ByteString Char -> ChatType -> Parser ByteString ChatType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatType
CTGroup Parser ByteString ChatType
-> Parser ByteString ChatType -> Parser ByteString ChatType
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
'*' Parser ByteString Char -> ChatType -> Parser ByteString ChatType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatType
CTLocal Parser ByteString ChatType
-> Parser ByteString ChatType -> Parser ByteString ChatType
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char -> ChatType -> Parser ByteString ChatType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatType
CTContactConnection
    chatPaginationP :: Parser ByteString ChatPagination
chatPaginationP =
      (Int -> ChatPagination
CPLast (Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> ChatPagination)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"count=" Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Int -> Parser ByteString ChatPagination
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
        Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int64 -> Int -> ChatPagination
CPAfter (Int64 -> Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int64 -> Int -> ChatPagination)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"after=" Parser ByteString (Int64 -> Int -> ChatPagination)
-> Parser ByteString Int64
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Char
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"count=" Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Int -> Parser ByteString ChatPagination
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
        Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int64 -> Int -> ChatPagination
CPBefore (Int64 -> Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int64 -> Int -> ChatPagination)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"before=" Parser ByteString (Int64 -> Int -> ChatPagination)
-> Parser ByteString Int64
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Char
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"count=" Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Int -> Parser ByteString ChatPagination
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
        Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int64 -> Int -> ChatPagination
CPAround (Int64 -> Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int64 -> Int -> ChatPagination)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"around=" Parser ByteString (Int64 -> Int -> ChatPagination)
-> Parser ByteString Int64
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Char
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> ChatPagination)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"count=" Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Int -> Parser ByteString ChatPagination
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
        Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
-> Parser ByteString ChatPagination
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> ChatPagination
CPInitial (Int -> ChatPagination)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> ChatPagination)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"initial=" Parser ByteString (Int -> ChatPagination)
-> Parser ByteString Int -> Parser ByteString ChatPagination
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
    paginationByTimeP :: Parser ByteString PaginationByTime
paginationByTimeP =
      (Int -> PaginationByTime
PTLast (Int -> PaginationByTime)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> PaginationByTime)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"count=" Parser ByteString (Int -> PaginationByTime)
-> Parser ByteString Int -> Parser ByteString PaginationByTime
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
        Parser ByteString PaginationByTime
-> Parser ByteString PaginationByTime
-> Parser ByteString PaginationByTime
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UTCTime -> Int -> PaginationByTime
PTAfter (UTCTime -> Int -> PaginationByTime)
-> Parser ByteString ByteString
-> Parser ByteString (UTCTime -> Int -> PaginationByTime)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"after=" Parser ByteString (UTCTime -> Int -> PaginationByTime)
-> Parser ByteString UTCTime
-> Parser ByteString (Int -> PaginationByTime)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UTCTime
forall a. StrEncoding a => Parser a
strP Parser ByteString (Int -> PaginationByTime)
-> Parser ByteString Char
-> Parser ByteString (Int -> PaginationByTime)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int -> PaginationByTime)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> PaginationByTime)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"count=" Parser ByteString (Int -> PaginationByTime)
-> Parser ByteString Int -> Parser ByteString PaginationByTime
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
        Parser ByteString PaginationByTime
-> Parser ByteString PaginationByTime
-> Parser ByteString PaginationByTime
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (UTCTime -> Int -> PaginationByTime
PTBefore (UTCTime -> Int -> PaginationByTime)
-> Parser ByteString ByteString
-> Parser ByteString (UTCTime -> Int -> PaginationByTime)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString ByteString
"before=" Parser ByteString (UTCTime -> Int -> PaginationByTime)
-> Parser ByteString UTCTime
-> Parser ByteString (Int -> PaginationByTime)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString UTCTime
forall a. StrEncoding a => Parser a
strP Parser ByteString (Int -> PaginationByTime)
-> Parser ByteString Char
-> Parser ByteString (Int -> PaginationByTime)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Int -> PaginationByTime)
-> Parser ByteString ByteString
-> Parser ByteString (Int -> PaginationByTime)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
"count=" Parser ByteString (Int -> PaginationByTime)
-> Parser ByteString Int -> Parser ByteString PaginationByTime
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal)
    mcTextP :: Parser ByteString MsgContent
mcTextP = Text -> MsgContent
MCText (Text -> MsgContent)
-> (ByteString -> Text) -> ByteString -> MsgContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> MsgContent)
-> Parser ByteString ByteString -> Parser ByteString MsgContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString
    msgContentP :: Parser ByteString MsgContent
msgContentP = Parser ByteString ByteString
"text " Parser ByteString ByteString
-> Parser ByteString MsgContent -> Parser ByteString MsgContent
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgContent
mcTextP Parser ByteString MsgContent
-> Parser ByteString MsgContent -> Parser ByteString MsgContent
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"json " Parser ByteString ByteString
-> Parser ByteString MsgContent -> Parser ByteString MsgContent
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgContent
forall a. FromJSON a => Parser a
jsonP
    chatDeleteMode :: Parser ByteString ChatDeleteMode
chatDeleteMode =
      [Parser ByteString ChatDeleteMode]
-> Parser ByteString ChatDeleteMode
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
        [ Parser ByteString ByteString
" full" Parser ByteString ByteString
-> Parser ByteString ChatDeleteMode
-> Parser ByteString ChatDeleteMode
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatDeleteMode
CDMFull (Bool -> ChatDeleteMode)
-> Parser ByteString Bool -> Parser ByteString ChatDeleteMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
notifyP),
          Parser ByteString ByteString
" entity" Parser ByteString ByteString
-> Parser ByteString ChatDeleteMode
-> Parser ByteString ChatDeleteMode
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> ChatDeleteMode
CDMEntity (Bool -> ChatDeleteMode)
-> Parser ByteString Bool -> Parser ByteString ChatDeleteMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
notifyP),
          Parser ByteString ByteString
" messages" Parser ByteString ByteString
-> ChatDeleteMode -> Parser ByteString ChatDeleteMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ChatDeleteMode
CDMMessages,
          Bool -> ChatDeleteMode
CDMFull (Bool -> ChatDeleteMode)
-> Parser ByteString Bool -> Parser ByteString ChatDeleteMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Bool
notifyP -- backwards compatible
        ]
      where
        notifyP :: Parser ByteString Bool
notifyP = Parser ByteString ByteString
" notify=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    sendMsgQuote :: AMsgDirection -> Parser ByteString ChatCommand
sendMsgQuote AMsgDirection
msgDir = Text -> AMsgDirection -> Text -> Text -> ChatCommand
SendMessageQuote (Text -> AMsgDirection -> Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (AMsgDirection -> Text -> Text -> ChatCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (AMsgDirection -> Text -> Text -> ChatCommand)
-> Parser ByteString Char
-> Parser ByteString (AMsgDirection -> Text -> Text -> ChatCommand)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (AMsgDirection -> Text -> Text -> ChatCommand)
-> Parser ByteString AMsgDirection
-> Parser ByteString (Text -> Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AMsgDirection -> Parser ByteString AMsgDirection
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AMsgDirection
msgDir Parser ByteString (Text -> Text -> ChatCommand)
-> Parser ByteString Text
-> Parser ByteString (Text -> ChatCommand)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
quotedMsg Parser ByteString (Text -> ChatCommand)
-> Parser ByteString Text -> Parser ByteString ChatCommand
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
msgTextP
    quotedMsg :: Parser ByteString Text
quotedMsg = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser ByteString Char
A.char Char
'(' Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')') Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
')') Parser ByteString Text
-> Parser ByteString (Maybe Char) -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Char
A.space
    reactionP :: Parser ByteString MsgReaction
reactionP = MREmojiChar -> MsgReaction
MREmoji (MREmojiChar -> MsgReaction)
-> Parser ByteString MREmojiChar -> Parser ByteString MsgReaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Either String MREmojiChar
mrEmojiChar (Char -> Either String MREmojiChar)
-> Parser ByteString Char -> Parser ByteString MREmojiChar
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Char
toEmoji (Char -> Char) -> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
A.anyChar))
    toEmoji :: Char -> Char
toEmoji = \case
      Char
'1' -> Char
'👍'
      Char
'+' -> Char
'👍'
      Char
'-' -> Char
'👎'
      Char
')' -> Char
'😀'
      Char
',' -> Char
'😢'
      Char
'*' -> String -> Char
forall a. HasCallStack => [a] -> a
head String
"❤️"
      Char
'^' -> Char
'🚀'
      Char
c -> Char
c
    composedMessagesTextP :: Parser ByteString (NonEmpty ComposedMessage)
composedMessagesTextP = do
      MsgContent
text <- Parser ByteString MsgContent
mcTextP
      NonEmpty ComposedMessage
-> Parser ByteString (NonEmpty ComposedMessage)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Maybe CryptoFile -> MsgContent -> ComposedMessage
composedMessage Maybe CryptoFile
forall a. Maybe a
Nothing MsgContent
text]
    updatedMessagesTextP :: Parser ByteString UpdatedMessage
updatedMessagesTextP = (MsgContent -> Map Text Int64 -> UpdatedMessage
`UpdatedMessage` []) (MsgContent -> UpdatedMessage)
-> Parser ByteString MsgContent -> Parser ByteString UpdatedMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString MsgContent
mcTextP
    liveMessageP :: Parser ByteString Bool
liveMessageP = Parser ByteString ByteString
" live=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    sendMessageTTLP :: Parser ByteString (Maybe Int)
sendMessageTTLP = Parser ByteString ByteString
" ttl=" Parser ByteString ByteString
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal) Parser ByteString (Maybe Int)
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"default" Parser ByteString ByteString
-> Maybe Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Int
forall a. Maybe a
Nothing)) Parser ByteString (Maybe Int)
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> Parser ByteString (Maybe Int)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
    receiptSettings :: Parser ByteString UserMsgReceiptSettings
receiptSettings = do
      Bool
enable <- Parser ByteString Bool
onOffP
      Bool
clearOverrides <- (Parser ByteString ByteString
" clear_overrides=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      UserMsgReceiptSettings -> Parser ByteString UserMsgReceiptSettings
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserMsgReceiptSettings {Bool
enable :: Bool
enable :: Bool
enable, Bool
clearOverrides :: Bool
clearOverrides :: Bool
clearOverrides}
    onOffP :: Parser ByteString Bool
onOffP = (Parser ByteString ByteString
"on" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"off" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)
    profileNameDescr :: Parser ByteString (Text, Maybe Text)
profileNameDescr = (,) (Text -> Maybe Text -> (Text, Maybe Text))
-> Parser ByteString Text
-> Parser ByteString (Maybe Text -> (Text, Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP Parser ByteString (Maybe Text -> (Text, Maybe Text))
-> Parser ByteString (Maybe Text)
-> Parser ByteString (Text, Maybe Text)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe Text)
shortDescrP
    -- 'Help with bot':'link <ID>','Menu of commands':[...]
    botCommandsP :: Parser [ChatBotCommand]
    botCommandsP :: Parser ByteString [ChatBotCommand]
botCommandsP = Parser ByteString ChatBotCommand
commandP Parser ByteString ChatBotCommand
-> Parser ByteString Char -> Parser ByteString [ChatBotCommand]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy'` Char -> Parser ByteString Char
A.char Char
','
      where
        commandP :: Parser ByteString ChatBotCommand
commandP = do
          Text
label <- ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser ByteString ByteString
quoted Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')) Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
':')
          Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
label) (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty command label"
          Parser ByteString Char
A.peekChar' Parser ByteString Char
-> (Char -> Parser ByteString ChatBotCommand)
-> Parser ByteString ChatBotCommand
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Char
'{' -> Char -> Parser ByteString Char
A.char Char
'{' Parser ByteString Char
-> Parser ByteString ChatBotCommand
-> Parser ByteString ChatBotCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> [ChatBotCommand] -> ChatBotCommand
CBCMenu Text
label ([ChatBotCommand] -> ChatBotCommand)
-> Parser ByteString [ChatBotCommand]
-> Parser ByteString ChatBotCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [ChatBotCommand]
botCommandsP) Parser ByteString ChatBotCommand
-> Parser ByteString Char -> Parser ByteString ChatBotCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
'}'
            Char
_ -> do
              Text
cmd <- ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
'/') Parser ByteString (Maybe Char)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString ByteString
quoted Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (String -> Char -> Bool
A.inClass String
":,}")))
              (Text
keyword, Maybe Text
params) <- case Text -> [Text]
T.words Text
cmd of
                [] -> String -> Parser ByteString (Text, Maybe Text)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty command"
                Text
k : [Text]
ws -> (Text, Maybe Text) -> Parser ByteString (Text, Maybe Text)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
k, if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ws then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text]
ws)
              ChatBotCommand -> Parser ByteString ChatBotCommand
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CBCCommand {Text
label :: Text
label :: Text
label, Text
keyword :: Text
keyword :: Text
keyword, Maybe Text
params :: Maybe Text
params :: Maybe Text
params}
        quoted :: Parser ByteString ByteString
quoted = Char -> Parser ByteString Char
A.char Char
'\'' Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
'\''
    newUserP :: Parser ByteString NewUser
newUserP = do
      (Text
cName, Maybe Text
shortDescr) <- Parser ByteString (Text, Maybe Text)
profileNameDescr
      let profile :: Maybe Profile
profile = Profile -> Maybe Profile
forall a. a -> Maybe a
Just Profile {displayName :: Text
displayName = Text
cName, fullName :: Text
fullName = Text
"", Maybe Text
shortDescr :: Maybe Text
shortDescr :: Maybe Text
shortDescr, image :: Maybe ImageData
image = Maybe ImageData
forall a. Maybe a
Nothing, contactLink :: Maybe ConnLinkContact
contactLink = Maybe ConnLinkContact
forall a. Maybe a
Nothing, peerType :: Maybe ChatPeerType
peerType = Maybe ChatPeerType
forall a. Maybe a
Nothing, preferences :: Maybe Preferences
preferences = Maybe Preferences
forall a. Maybe a
Nothing}
      NewUser -> Parser ByteString NewUser
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewUser {Maybe Profile
profile :: Maybe Profile
profile :: Maybe Profile
profile, pastTimestamp :: Bool
pastTimestamp = Bool
False}
    newBotUserP :: Parser ByteString NewUser
newBotUserP = do
      Maybe Bool
files_ <- Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Bool -> Parser ByteString (Maybe Bool))
-> Parser ByteString Bool -> Parser ByteString (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
"files=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Char -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space
      (Text
cName, Maybe Text
shortDescr) <- Parser ByteString (Text, Maybe Text)
profileNameDescr
      let preferences :: Maybe Preferences
preferences = case Maybe Bool
files_ of
            Just Bool
True -> Maybe Preferences
forall a. Maybe a
Nothing
            Maybe Bool
_ -> Preferences -> Maybe Preferences
forall a. a -> Maybe a
Just (Preferences
emptyChatPrefs :: Preferences) {files = Just FilesPreference {allow = FANo}}
          profile :: Maybe Profile
profile = Profile -> Maybe Profile
forall a. a -> Maybe a
Just Profile {displayName :: Text
displayName = Text
cName, fullName :: Text
fullName = Text
"", Maybe Text
shortDescr :: Maybe Text
shortDescr :: Maybe Text
shortDescr, image :: Maybe ImageData
image = Maybe ImageData
forall a. Maybe a
Nothing, contactLink :: Maybe ConnLinkContact
contactLink = Maybe ConnLinkContact
forall a. Maybe a
Nothing, peerType :: Maybe ChatPeerType
peerType = ChatPeerType -> Maybe ChatPeerType
forall a. a -> Maybe a
Just ChatPeerType
CPTBot, Maybe Preferences
preferences :: Maybe Preferences
preferences :: Maybe Preferences
preferences}
      NewUser -> Parser ByteString NewUser
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NewUser {Maybe Profile
profile :: Maybe Profile
profile :: Maybe Profile
profile, pastTimestamp :: Bool
pastTimestamp = Bool
False}
    jsonP :: J.FromJSON a => Parser a
    jsonP :: forall a. FromJSON a => Parser a
jsonP = ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecodeStrict' (ByteString -> Either String a)
-> Parser ByteString ByteString -> Parser ByteString a
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString ByteString
A.takeByteString
    groupProfile :: Parser ByteString GroupProfile
groupProfile = do
      (Text
gName, Maybe Text
shortDescr) <- Parser ByteString (Text, Maybe Text)
profileNameDescr
      let groupPreferences :: Maybe GroupPreferences
groupPreferences =
            GroupPreferences -> Maybe GroupPreferences
forall a. a -> Maybe a
Just
              (GroupPreferences
emptyGroupPrefs :: GroupPreferences)
                { directMessages = Just DirectMessagesGroupPreference {enable = FEOn, role = Nothing},
                  history = Just HistoryGroupPreference {enable = FEOn}
                }
      GroupProfile -> Parser ByteString GroupProfile
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GroupProfile {displayName :: Text
displayName = Text
gName, fullName :: Text
fullName = Text
"", Maybe Text
shortDescr :: Maybe Text
shortDescr :: Maybe Text
shortDescr, description :: Maybe Text
description = Maybe Text
forall a. Maybe a
Nothing, image :: Maybe ImageData
image = Maybe ImageData
forall a. Maybe a
Nothing, Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences :: Maybe GroupPreferences
groupPreferences, memberAdmission :: Maybe GroupMemberAdmission
memberAdmission = Maybe GroupMemberAdmission
forall a. Maybe a
Nothing}
    memberCriteriaP :: Parser ByteString (Maybe MemberCriteria)
memberCriteriaP = (Parser ByteString ByteString
"all" Parser ByteString ByteString
-> Maybe MemberCriteria -> Parser ByteString (Maybe MemberCriteria)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MemberCriteria -> Maybe MemberCriteria
forall a. a -> Maybe a
Just MemberCriteria
MCAll) Parser ByteString (Maybe MemberCriteria)
-> Parser ByteString (Maybe MemberCriteria)
-> Parser ByteString (Maybe MemberCriteria)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"off" Parser ByteString ByteString
-> Maybe MemberCriteria -> Parser ByteString (Maybe MemberCriteria)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe MemberCriteria
forall a. Maybe a
Nothing)
    shortDescrP :: Parser ByteString (Maybe Text)
shortDescrP = do
      Text
descr <- (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Char -> Bool
isSpace Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace (Text -> Text) -> Parser ByteString Text -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
textP) Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
      Maybe Text -> Parser ByteString (Maybe Text)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Parser ByteString (Maybe Text))
-> Maybe Text -> Parser ByteString (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
descr then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
160 Text
descr
    textP :: Parser ByteString Text
textP = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString
    pwdP :: Parser ByteString UserPwd
pwdP = Parser ByteString UserPwd
forall a. FromJSON a => Parser a
jsonP Parser ByteString UserPwd
-> Parser ByteString UserPwd -> Parser ByteString UserPwd
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> UserPwd
UserPwd (Text -> UserPwd) -> (ByteString -> Text) -> ByteString -> UserPwd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> UserPwd)
-> Parser ByteString ByteString -> Parser ByteString UserPwd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '))
    verifyCodeP :: Parser ByteString Text
verifyCodeP = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
    msgTextP :: Parser ByteString Text
msgTextP = Parser ByteString Text
forall a. FromJSON a => Parser a
jsonP Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Text
textP
    stringP :: Parser ByteString String
stringP = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> String)
-> Parser ByteString ByteString -> Parser ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeByteString
    filePath :: Parser ByteString String
filePath = Parser ByteString String
stringP
    cryptoFileP :: Parser ByteString CryptoFile
cryptoFileP = do
      Maybe CryptoFileArgs
cfArgs <- Parser ByteString CryptoFileArgs
-> Parser ByteString (Maybe CryptoFileArgs)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString CryptoFileArgs
 -> Parser ByteString (Maybe CryptoFileArgs))
-> Parser ByteString CryptoFileArgs
-> Parser ByteString (Maybe CryptoFileArgs)
forall a b. (a -> b) -> a -> b
$ SbKey -> CbNonce -> CryptoFileArgs
CFArgs (SbKey -> CbNonce -> CryptoFileArgs)
-> Parser ByteString SbKey
-> Parser ByteString (CbNonce -> CryptoFileArgs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" key=" Parser ByteString ByteString
-> Parser ByteString SbKey -> Parser ByteString SbKey
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SbKey
forall a. StrEncoding a => Parser a
strP Parser ByteString SbKey
-> Parser ByteString Char -> Parser ByteString SbKey
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space) Parser ByteString (CbNonce -> CryptoFileArgs)
-> Parser ByteString CbNonce -> Parser ByteString CryptoFileArgs
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" nonce=" Parser ByteString ByteString
-> Parser ByteString CbNonce -> Parser ByteString CbNonce
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString CbNonce
forall a. StrEncoding a => Parser a
strP)
      String
path <- Parser ByteString String
filePath
      CryptoFile -> Parser ByteString CryptoFile
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CryptoFile -> Parser ByteString CryptoFile)
-> CryptoFile -> Parser ByteString CryptoFile
forall a b. (a -> b) -> a -> b
$ String -> Maybe CryptoFileArgs -> CryptoFile
CryptoFile String
path Maybe CryptoFileArgs
cfArgs
    connMsgsP :: Parser ByteString (NonEmpty ConnMsgReq)
connMsgsP = [ConnMsgReq] -> NonEmpty ConnMsgReq
forall a. HasCallStack => [a] -> NonEmpty a
L.fromList ([ConnMsgReq] -> NonEmpty ConnMsgReq)
-> Parser ByteString [ConnMsgReq]
-> Parser ByteString (NonEmpty ConnMsgReq)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ConnMsgReq
connMsgP Parser ByteString ConnMsgReq
-> Parser ByteString Char -> Parser ByteString [ConnMsgReq]
forall (m :: * -> *) a s. MonadPlus m => m a -> m s -> m [a]
`A.sepBy1'` Char -> Parser ByteString Char
A.char Char
','
    connMsgP :: Parser ByteString ConnMsgReq
connMsgP = do
      AgentConnId ByteString
msgConnId <- Parser AgentConnId
forall a. StrEncoding a => Parser a
strP Parser AgentConnId -> Parser ByteString Char -> Parser AgentConnId
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
':'
      Int64
msgDbQueueId <- Parser ByteString Int64
forall a. StrEncoding a => Parser a
strP Parser ByteString Int64
-> Parser ByteString Char -> Parser ByteString Int64
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
':'
      UTCTime
ts <- Parser ByteString UTCTime
forall a. StrEncoding a => Parser a
strP
      ConnMsgReq -> Parser ByteString ConnMsgReq
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnMsgReq {ByteString
msgConnId :: ByteString
msgConnId :: ByteString
msgConnId, Int64
msgDbQueueId :: Int64
msgDbQueueId :: Int64
msgDbQueueId, msgTs :: Maybe UTCTime
msgTs = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
ts}
    memberRole :: Parser ByteString GroupMemberRole
memberRole =
      [Parser ByteString GroupMemberRole]
-> Parser ByteString GroupMemberRole
forall (f :: * -> *) a. Alternative f => [f a] -> f a
A.choice
        [ Parser ByteString ByteString
" owner" Parser ByteString ByteString
-> GroupMemberRole -> Parser ByteString GroupMemberRole
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GroupMemberRole
GROwner,
          Parser ByteString ByteString
" admin" Parser ByteString ByteString
-> GroupMemberRole -> Parser ByteString GroupMemberRole
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GroupMemberRole
GRAdmin,
          Parser ByteString ByteString
" moderator" Parser ByteString ByteString
-> GroupMemberRole -> Parser ByteString GroupMemberRole
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GroupMemberRole
GRModerator,
          Parser ByteString ByteString
" member" Parser ByteString ByteString
-> GroupMemberRole -> Parser ByteString GroupMemberRole
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GroupMemberRole
GRMember,
          Parser ByteString ByteString
" observer" Parser ByteString ByteString
-> GroupMemberRole -> Parser ByteString GroupMemberRole
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GroupMemberRole
GRObserver
        ]
    chatNameP :: Parser ByteString ChatName
chatNameP =
      Parser ByteString ChatType
chatTypeP Parser ByteString ChatType
-> (ChatType -> Parser ByteString ChatName)
-> Parser ByteString ChatName
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ChatType
CTLocal -> ChatName -> Parser ByteString ChatName
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChatName -> Parser ByteString ChatName)
-> ChatName -> Parser ByteString ChatName
forall a b. (a -> b) -> a -> b
$ ChatType -> Text -> ChatName
ChatName ChatType
CTLocal Text
""
        ChatType
ct -> ChatType -> Text -> ChatName
ChatName ChatType
ct (Text -> ChatName)
-> Parser ByteString Text -> Parser ByteString ChatName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
displayNameP
    chatNameP' :: Parser ByteString ChatName
chatNameP' = ChatType -> Text -> ChatName
ChatName (ChatType -> Text -> ChatName)
-> Parser ByteString ChatType
-> Parser ByteString (Text -> ChatName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ChatType
chatTypeP Parser ByteString ChatType
-> Parser ByteString ChatType -> Parser ByteString ChatType
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ChatType -> Parser ByteString ChatType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChatType
CTDirect) Parser ByteString (Text -> ChatName)
-> Parser ByteString Text -> Parser ByteString ChatName
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP
    chatRefP :: Parser ByteString ChatRef
chatRefP = do
      Parser ByteString ChatType
chatTypeP Parser ByteString ChatType
-> (ChatType -> Parser ByteString ChatRef)
-> Parser ByteString ChatRef
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ChatType
CTGroup -> ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
CTGroup (Int64 -> Maybe GroupChatScope -> ChatRef)
-> Parser ByteString Int64
-> Parser ByteString (Maybe GroupChatScope -> ChatRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe GroupChatScope -> ChatRef)
-> Parser ByteString (Maybe GroupChatScope)
-> Parser ByteString ChatRef
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupChatScope
-> Parser ByteString (Maybe GroupChatScope)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString GroupChatScope
gcScopeP
        ChatType
cType -> (\Int64
chatId -> ChatType -> Int64 -> Maybe GroupChatScope -> ChatRef
ChatRef ChatType
cType Int64
chatId Maybe GroupChatScope
forall a. Maybe a
Nothing) (Int64 -> ChatRef)
-> Parser ByteString Int64 -> Parser ByteString ChatRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal
    sendRefP :: Parser ByteString SendRef
sendRefP =
      (Char -> Parser ByteString Char
A.char Char
'@' Parser ByteString Char
-> (Int64 -> SendRef) -> Parser ByteString (Int64 -> SendRef)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int64 -> SendRef
SRDirect Parser ByteString (Int64 -> SendRef)
-> Parser ByteString Int64 -> Parser ByteString SendRef
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal)
        Parser ByteString SendRef
-> Parser ByteString SendRef -> Parser ByteString SendRef
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser ByteString Char
A.char Char
'#' Parser ByteString Char
-> (Int64 -> Maybe GroupChatScope -> SendRef)
-> Parser ByteString (Int64 -> Maybe GroupChatScope -> SendRef)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int64 -> Maybe GroupChatScope -> SendRef
SRGroup Parser ByteString (Int64 -> Maybe GroupChatScope -> SendRef)
-> Parser ByteString Int64
-> Parser ByteString (Maybe GroupChatScope -> SendRef)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString (Maybe GroupChatScope -> SendRef)
-> Parser ByteString (Maybe GroupChatScope)
-> Parser ByteString SendRef
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString GroupChatScope
-> Parser ByteString (Maybe GroupChatScope)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString GroupChatScope
gcScopeP)
    gcScopeP :: Parser ByteString GroupChatScope
gcScopeP = Parser ByteString ByteString
"(_support" Parser ByteString ByteString
-> Parser ByteString GroupChatScope
-> Parser ByteString GroupChatScope
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Maybe Int64 -> GroupChatScope
GCSMemberSupport (Maybe Int64 -> GroupChatScope)
-> Parser ByteString (Maybe Int64)
-> Parser ByteString GroupChatScope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ByteString Int64 -> Parser ByteString Int64
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal)) Parser ByteString GroupChatScope
-> Parser ByteString Char -> Parser ByteString GroupChatScope
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
')'
    sendNameP :: Parser ByteString SendName
sendNameP =
      (Char -> Parser ByteString Char
A.char Char
'@' Parser ByteString Char
-> (Text -> SendName) -> Parser ByteString (Text -> SendName)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text -> SendName
SNDirect Parser ByteString (Text -> SendName)
-> Parser ByteString Text -> Parser ByteString SendName
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP)
        Parser ByteString SendName
-> Parser ByteString SendName -> Parser ByteString SendName
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser ByteString Char
A.char Char
'#' Parser ByteString Char
-> (Text -> Maybe GroupScopeName -> SendName)
-> Parser ByteString (Text -> Maybe GroupScopeName -> SendName)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text -> Maybe GroupScopeName -> SendName
SNGroup Parser ByteString (Text -> Maybe GroupScopeName -> SendName)
-> Parser ByteString Text
-> Parser ByteString (Maybe GroupScopeName -> SendName)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Text
displayNameP Parser ByteString (Maybe GroupScopeName -> SendName)
-> Parser ByteString (Maybe GroupScopeName)
-> Parser ByteString SendName
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe GroupScopeName)
gScopeNameP)
        Parser ByteString SendName
-> Parser ByteString SendName -> Parser ByteString SendName
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"/*" Parser ByteString ByteString
-> SendName -> Parser ByteString SendName
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SendName
SNLocal)
    gScopeNameP :: Parser ByteString (Maybe GroupScopeName)
gScopeNameP =
      (Parser ByteString ByteString
supportPfx Parser ByteString ByteString
-> Parser ByteString (Maybe GroupScopeName)
-> Parser ByteString (Maybe GroupScopeName)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (GroupScopeName -> Maybe GroupScopeName
forall a. a -> Maybe a
Just (GroupScopeName -> Maybe GroupScopeName)
-> (Maybe Text -> GroupScopeName)
-> Maybe Text
-> Maybe GroupScopeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> GroupScopeName
GSNMemberSupport (Maybe Text -> Maybe GroupScopeName)
-> Parser ByteString (Maybe Text)
-> Parser ByteString (Maybe GroupScopeName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString Text
supportMember) Parser ByteString (Maybe GroupScopeName)
-> Parser ByteString Char
-> Parser ByteString (Maybe GroupScopeName)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
')')
        -- this branch fails on "(support" followed by incorrect syntax,
        -- to avoid sending message to the whole group as `optional gScopeNameP` would do
        Parser ByteString (Maybe GroupScopeName)
-> Parser ByteString (Maybe GroupScopeName)
-> Parser ByteString (Maybe GroupScopeName)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
-> Parser ByteString (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ByteString
supportPfx Parser ByteString (Maybe ByteString)
-> (Maybe ByteString -> Parser ByteString (Maybe GroupScopeName))
-> Parser ByteString (Maybe GroupScopeName)
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Parser ByteString GroupScopeName)
-> Maybe ByteString -> Parser ByteString (Maybe GroupScopeName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (\ByteString
_ -> String -> Parser ByteString GroupScopeName
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad chat scope"))
      where
        supportPfx :: Parser ByteString ByteString
supportPfx = (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile Char -> Bool
isSpace Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
"(support"
        supportMember :: Parser ByteString Text
supportMember = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile Char -> Bool
isSpace Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> Parser ByteString ByteString
A.take (Int -> Parser ByteString ByteString)
-> (ByteString -> Int)
-> ByteString
-> Parser ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
lengthTillLastParen (ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Parser ByteString ByteString -> Parser ByteString ByteString
forall i a. Parser i a -> Parser i a
A.lookAhead Parser ByteString ByteString
displayNameP_))
        lengthTillLastParen :: ByteString -> Int
lengthTillLastParen ByteString
s = case ByteString -> Maybe (ByteString, Char)
B.unsnoc ByteString
s of
          Just (ByteString
_, Char
')') -> ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          Maybe (ByteString, Char)
_ -> ByteString -> Int
B.length ByteString
s
    msgCountP :: Parser ByteString Int
msgCountP = Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
10
    ciTTLDecimal :: Parser ByteString (Maybe Int64)
ciTTLDecimal = (Parser ByteString ByteString
"default" Parser ByteString ByteString
-> Maybe Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Int64
forall a. Maybe a
Nothing) Parser ByteString (Maybe Int64)
-> Parser ByteString (Maybe Int64)
-> Parser ByteString (Maybe Int64)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64)
-> Parser ByteString Int64 -> Parser ByteString (Maybe Int64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal)
    ciTTL :: Parser ByteString Int64
ciTTL =
      (Parser ByteString ByteString
"day" Parser ByteString ByteString -> Int64 -> Parser ByteString Int64
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int64
86400)
        Parser ByteString Int64
-> Parser ByteString Int64 -> Parser ByteString Int64
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"week" Parser ByteString ByteString -> Int64 -> Parser ByteString Int64
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Int64
7 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
86400))
        Parser ByteString Int64
-> Parser ByteString Int64 -> Parser ByteString Int64
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"month" Parser ByteString ByteString -> Int64 -> Parser ByteString Int64
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Int64
30 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
86400))
        Parser ByteString Int64
-> Parser ByteString Int64 -> Parser ByteString Int64
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"year" Parser ByteString ByteString -> Int64 -> Parser ByteString Int64
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Int64
365 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
86400))
        Parser ByteString Int64
-> Parser ByteString Int64 -> Parser ByteString Int64
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"none" Parser ByteString ByteString -> Int64 -> Parser ByteString Int64
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int64
0)
    timedTTLP :: Parser ByteString Int
timedTTLP =
      (Parser ByteString ByteString
"30s" Parser ByteString ByteString -> Int -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
30)
        Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"5min" Parser ByteString ByteString -> Int -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
300)
        Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"1h" Parser ByteString ByteString -> Int -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
3600)
        Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"8h" Parser ByteString ByteString -> Int -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600))
        Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"day" Parser ByteString ByteString -> Int -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
86400)
        Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"week" Parser ByteString ByteString -> Int -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
86400))
        Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"month" Parser ByteString ByteString -> Int -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Int
30 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
86400))
        Parser ByteString Int
-> Parser ByteString Int -> Parser ByteString Int
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal
    timedTTLOnOffP :: Parser ByteString (Maybe Int)
timedTTLOnOffP =
      Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
"on" Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
A.space) Parser ByteString (Maybe Char)
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
timedTTLP)
        Parser ByteString (Maybe Int)
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"off" Parser ByteString ByteString
-> Maybe Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Int
forall a. Maybe a
Nothing)
    timedMessagesEnabledP :: Parser ByteString TimedMessagesEnabled
timedMessagesEnabledP =
      Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ByteString
"yes" Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Char
A.space) Parser ByteString (Maybe Char)
-> Parser ByteString TimedMessagesEnabled
-> Parser ByteString TimedMessagesEnabled
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> TimedMessagesEnabled
TMEEnableSetTTL (Int -> TimedMessagesEnabled)
-> Parser ByteString Int -> Parser ByteString TimedMessagesEnabled
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
timedTTLP)
        Parser ByteString TimedMessagesEnabled
-> Parser ByteString TimedMessagesEnabled
-> Parser ByteString TimedMessagesEnabled
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"yes" Parser ByteString ByteString
-> TimedMessagesEnabled -> Parser ByteString TimedMessagesEnabled
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TimedMessagesEnabled
TMEEnableKeepTTL)
        Parser ByteString TimedMessagesEnabled
-> Parser ByteString TimedMessagesEnabled
-> Parser ByteString TimedMessagesEnabled
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
"no" Parser ByteString ByteString
-> TimedMessagesEnabled -> Parser ByteString TimedMessagesEnabled
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TimedMessagesEnabled
TMEDisableKeepTTL)
    operatorRolesP :: Parser ByteString ServerOperatorRoles
operatorRolesP = do
      Int64
operatorId' <- Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal
      Bool
enabled' <- Char -> Parser ByteString Char
A.char Char
':' Parser ByteString Char
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP
      ServerRoles
smpRoles' <- (Parser ByteString ByteString
":smp=" Parser ByteString ByteString
-> Parser ByteString ServerRoles -> Parser ByteString ServerRoles
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ServerRoles
srvRolesP) Parser ByteString ServerRoles
-> Parser ByteString ServerRoles -> Parser ByteString ServerRoles
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ServerRoles -> Parser ByteString ServerRoles
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerRoles
allRoles
      ServerRoles
xftpRoles' <- (Parser ByteString ByteString
":xftp=" Parser ByteString ByteString
-> Parser ByteString ServerRoles -> Parser ByteString ServerRoles
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ServerRoles
srvRolesP) Parser ByteString ServerRoles
-> Parser ByteString ServerRoles -> Parser ByteString ServerRoles
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ServerRoles -> Parser ByteString ServerRoles
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerRoles
allRoles
      ServerOperatorRoles -> Parser ByteString ServerOperatorRoles
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerOperatorRoles {Int64
operatorId' :: Int64
operatorId' :: Int64
operatorId', Bool
enabled' :: Bool
enabled' :: Bool
enabled', ServerRoles
smpRoles' :: ServerRoles
smpRoles' :: ServerRoles
smpRoles', ServerRoles
xftpRoles' :: ServerRoles
xftpRoles' :: ServerRoles
xftpRoles'}
    srvRolesP :: Parser ByteString ServerRoles
srvRolesP = ByteString -> Either String ServerRoles
srvRoles (ByteString -> Either String ServerRoles)
-> Parser ByteString ByteString -> Parser ByteString ServerRoles
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')
      where
        srvRoles :: ByteString -> Either String ServerRoles
srvRoles = \case
          ByteString
"off" -> ServerRoles -> Either String ServerRoles
forall a b. b -> Either a b
Right (ServerRoles -> Either String ServerRoles)
-> ServerRoles -> Either String ServerRoles
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> ServerRoles
ServerRoles Bool
False Bool
False
          ByteString
"proxy" -> ServerRoles -> Either String ServerRoles
forall a b. b -> Either a b
Right ServerRoles {storage :: Bool
storage = Bool
False, proxy :: Bool
proxy = Bool
True}
          ByteString
"storage" -> ServerRoles -> Either String ServerRoles
forall a b. b -> Either a b
Right ServerRoles {storage :: Bool
storage = Bool
True, proxy :: Bool
proxy = Bool
False}
          ByteString
"on" -> ServerRoles -> Either String ServerRoles
forall a b. b -> Either a b
Right ServerRoles
allRoles
          ByteString
_ -> String -> Either String ServerRoles
forall a b. a -> Either a b
Left String
"bad ServerRoles"
    netCfgP :: Parser ByteString SimpleNetCfg
netCfgP = do
      Maybe SocksProxyWithAuth
socksProxy <- Parser ByteString ByteString
"socks=" Parser ByteString ByteString
-> Parser ByteString (Maybe SocksProxyWithAuth)
-> Parser ByteString (Maybe SocksProxyWithAuth)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString ByteString
"off" Parser ByteString ByteString
-> Maybe SocksProxyWithAuth
-> Parser ByteString (Maybe SocksProxyWithAuth)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe SocksProxyWithAuth
forall a. Maybe a
Nothing Parser ByteString (Maybe SocksProxyWithAuth)
-> Parser ByteString (Maybe SocksProxyWithAuth)
-> Parser ByteString (Maybe SocksProxyWithAuth)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"on" Parser ByteString ByteString
-> Maybe SocksProxyWithAuth
-> Parser ByteString (Maybe SocksProxyWithAuth)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SocksProxyWithAuth -> Maybe SocksProxyWithAuth
forall a. a -> Maybe a
Just SocksProxyWithAuth
defaultSocksProxyWithAuth Parser ByteString (Maybe SocksProxyWithAuth)
-> Parser ByteString (Maybe SocksProxyWithAuth)
-> Parser ByteString (Maybe SocksProxyWithAuth)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SocksProxyWithAuth -> Maybe SocksProxyWithAuth
forall a. a -> Maybe a
Just (SocksProxyWithAuth -> Maybe SocksProxyWithAuth)
-> Parser ByteString SocksProxyWithAuth
-> Parser ByteString (Maybe SocksProxyWithAuth)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SocksProxyWithAuth
forall a. StrEncoding a => Parser a
strP)
      SocksMode
socksMode <- Parser ByteString ByteString
" socks-mode=" Parser ByteString ByteString
-> Parser ByteString SocksMode -> Parser ByteString SocksMode
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SocksMode
forall a. StrEncoding a => Parser a
strP Parser ByteString SocksMode
-> Parser ByteString SocksMode -> Parser ByteString SocksMode
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SocksMode -> Parser ByteString SocksMode
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SocksMode
SMAlways
      HostMode
hostMode <- Parser ByteString ByteString
" host-mode=" Parser ByteString ByteString
-> Parser ByteString HostMode -> Parser ByteString HostMode
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Either String HostMode
textToHostMode (Text -> Either String HostMode)
-> (ByteString -> Text) -> ByteString -> Either String HostMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
safeDecodeUtf8 (ByteString -> Either String HostMode)
-> Parser ByteString ByteString -> Parser ByteString HostMode
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) Parser ByteString HostMode
-> Parser ByteString HostMode -> Parser ByteString HostMode
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HostMode -> Parser ByteString HostMode
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SocksProxyWithAuth -> HostMode
defaultHostMode Maybe SocksProxyWithAuth
socksProxy)
      Bool
requiredHostMode <- (Parser ByteString ByteString
" required-host-mode" Parser ByteString ByteString -> Bool -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Maybe SMPProxyMode
smpProxyMode_ <- Parser ByteString SMPProxyMode
-> Parser ByteString (Maybe SMPProxyMode)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString SMPProxyMode
 -> Parser ByteString (Maybe SMPProxyMode))
-> Parser ByteString SMPProxyMode
-> Parser ByteString (Maybe SMPProxyMode)
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
" smp-proxy=" Parser ByteString ByteString
-> Parser ByteString SMPProxyMode -> Parser ByteString SMPProxyMode
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SMPProxyMode
forall a. StrEncoding a => Parser a
strP
      Maybe SMPProxyFallback
smpProxyFallback_ <- Parser ByteString SMPProxyFallback
-> Parser ByteString (Maybe SMPProxyFallback)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString SMPProxyFallback
 -> Parser ByteString (Maybe SMPProxyFallback))
-> Parser ByteString SMPProxyFallback
-> Parser ByteString (Maybe SMPProxyFallback)
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
" smp-proxy-fallback=" Parser ByteString ByteString
-> Parser ByteString SMPProxyFallback
-> Parser ByteString SMPProxyFallback
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SMPProxyFallback
forall a. StrEncoding a => Parser a
strP
      SMPWebPortServers
smpWebPortServers <- (Parser ByteString ByteString
" smp-web-port-servers=" Parser ByteString ByteString
-> Parser ByteString SMPWebPortServers
-> Parser ByteString SMPWebPortServers
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString SMPWebPortServers
forall a. StrEncoding a => Parser a
strP) Parser ByteString SMPWebPortServers
-> Parser ByteString SMPWebPortServers
-> Parser ByteString SMPWebPortServers
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString ByteString
" smp-web-port" Parser ByteString ByteString
-> SMPWebPortServers -> Parser ByteString SMPWebPortServers
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SMPWebPortServers
SWPAll) Parser ByteString SMPWebPortServers
-> Parser ByteString SMPWebPortServers
-> Parser ByteString SMPWebPortServers
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SMPWebPortServers -> Parser ByteString SMPWebPortServers
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SMPWebPortServers
SWPPreset
      Maybe Int
t_ <- Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Int -> Parser ByteString (Maybe Int))
-> Parser ByteString Int -> Parser ByteString (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString
" timeout=" Parser ByteString ByteString
-> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal
      Bool
logTLSErrors <- Parser ByteString ByteString
" log=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      let tcpTimeout_ :: Maybe Int
tcpTimeout_ = (Int
1000000 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
t_
      SimpleNetCfg -> Parser ByteString SimpleNetCfg
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SimpleNetCfg -> Parser ByteString SimpleNetCfg)
-> SimpleNetCfg -> Parser ByteString SimpleNetCfg
forall a b. (a -> b) -> a -> b
$ SimpleNetCfg {Maybe SocksProxyWithAuth
socksProxy :: Maybe SocksProxyWithAuth
socksProxy :: Maybe SocksProxyWithAuth
socksProxy, SocksMode
socksMode :: SocksMode
socksMode :: SocksMode
socksMode, HostMode
hostMode :: HostMode
hostMode :: HostMode
hostMode, Bool
requiredHostMode :: Bool
requiredHostMode :: Bool
requiredHostMode, Maybe SMPProxyMode
smpProxyMode_ :: Maybe SMPProxyMode
smpProxyMode_ :: Maybe SMPProxyMode
smpProxyMode_, Maybe SMPProxyFallback
smpProxyFallback_ :: Maybe SMPProxyFallback
smpProxyFallback_ :: Maybe SMPProxyFallback
smpProxyFallback_, SMPWebPortServers
smpWebPortServers :: SMPWebPortServers
smpWebPortServers :: SMPWebPortServers
smpWebPortServers, Maybe Int
tcpTimeout_ :: Maybe Int
tcpTimeout_ :: Maybe Int
tcpTimeout_, Bool
logTLSErrors :: Bool
logTLSErrors :: Bool
logTLSErrors}
#if !defined(dbPostgres)
    dbKeyP :: Parser ByteString DBEncryptionKey
dbKeyP = DBEncryptionKey -> Either String DBEncryptionKey
forall {a}.
IsString a =>
DBEncryptionKey -> Either a DBEncryptionKey
nonEmptyKey (DBEncryptionKey -> Either String DBEncryptionKey)
-> Parser ByteString DBEncryptionKey
-> Parser ByteString DBEncryptionKey
forall (m :: * -> *) a b.
MonadFail m =>
(a -> Either String b) -> m a -> m b
<$?> Parser ByteString DBEncryptionKey
forall a. StrEncoding a => Parser a
strP
    nonEmptyKey :: DBEncryptionKey -> Either a DBEncryptionKey
nonEmptyKey k :: DBEncryptionKey
k@(DBEncryptionKey ScrubbedBytes
s) = if ScrubbedBytes -> Bool
forall a. ByteArrayAccess a => a -> Bool
BA.null ScrubbedBytes
s then a -> Either a DBEncryptionKey
forall a b. a -> Either a b
Left a
"empty key" else DBEncryptionKey -> Either a DBEncryptionKey
forall a b. b -> Either a b
Right DBEncryptionKey
k
    dbEncryptionConfig :: DBEncryptionKey -> DBEncryptionKey -> DBEncryptionConfig
dbEncryptionConfig DBEncryptionKey
currentKey DBEncryptionKey
newKey = DBEncryptionConfig {DBEncryptionKey
currentKey :: DBEncryptionKey
currentKey :: DBEncryptionKey
currentKey, DBEncryptionKey
newKey :: DBEncryptionKey
newKey :: DBEncryptionKey
newKey, keepKey :: Maybe Bool
keepKey = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False}
#endif
    -- TODO [short links] parser for address settings
    autoAcceptP :: Parser ByteString AddressSettings
autoAcceptP = Parser ByteString Bool
-> Parser ByteString AddressSettings
-> Parser ByteString AddressSettings
-> Parser ByteString AddressSettings
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM Parser ByteString Bool
onOffP (Parser ByteString AddressSettings
businessAA Parser ByteString AddressSettings
-> Parser ByteString AddressSettings
-> Parser ByteString AddressSettings
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString AddressSettings
addressAA) (AddressSettings -> Parser ByteString AddressSettings
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddressSettings -> Parser ByteString AddressSettings)
-> AddressSettings -> Parser ByteString AddressSettings
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe AutoAccept -> Maybe MsgContent -> AddressSettings
AddressSettings Bool
False Maybe AutoAccept
forall a. Maybe a
Nothing Maybe MsgContent
forall a. Maybe a
Nothing)
      where
        addressAA :: Parser ByteString AddressSettings
addressAA = Bool -> Maybe AutoAccept -> Maybe MsgContent -> AddressSettings
AddressSettings Bool
False (Maybe AutoAccept -> Maybe MsgContent -> AddressSettings)
-> Parser ByteString (Maybe AutoAccept)
-> Parser ByteString (Maybe MsgContent -> AddressSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AutoAccept -> Maybe AutoAccept
forall a. a -> Maybe a
Just (AutoAccept -> Maybe AutoAccept)
-> (Bool -> AutoAccept) -> Bool -> Maybe AutoAccept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> AutoAccept
AutoAccept (Bool -> Maybe AutoAccept)
-> Parser ByteString Bool -> Parser ByteString (Maybe AutoAccept)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
" incognito=" Parser ByteString ByteString
-> Parser ByteString Bool -> Parser ByteString Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Bool
onOffP Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)) Parser ByteString (Maybe MsgContent -> AddressSettings)
-> Parser ByteString (Maybe MsgContent)
-> Parser ByteString AddressSettings
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Maybe MsgContent)
autoReply
        businessAA :: Parser ByteString AddressSettings
businessAA = Parser ByteString ByteString
" business" Parser ByteString ByteString
-> Parser ByteString AddressSettings
-> Parser ByteString AddressSettings
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Bool -> Maybe AutoAccept -> Maybe MsgContent -> AddressSettings
AddressSettings Bool
True (AutoAccept -> Maybe AutoAccept
forall a. a -> Maybe a
Just (AutoAccept -> Maybe AutoAccept) -> AutoAccept -> Maybe AutoAccept
forall a b. (a -> b) -> a -> b
$ Bool -> AutoAccept
AutoAccept Bool
False) (Maybe MsgContent -> AddressSettings)
-> Parser ByteString (Maybe MsgContent)
-> Parser ByteString AddressSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe MsgContent)
autoReply)
        autoReply :: Parser ByteString (Maybe MsgContent)
autoReply = Parser ByteString MsgContent
-> Parser ByteString (Maybe MsgContent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString MsgContent -> Parser ByteString MsgContent
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString MsgContent
msgContentP)
    rcCtrlAddressP :: Parser ByteString RCCtrlAddress
rcCtrlAddressP = TransportHost -> Text -> RCCtrlAddress
RCCtrlAddress (TransportHost -> Text -> RCCtrlAddress)
-> Parser ByteString TransportHost
-> Parser ByteString (Text -> RCCtrlAddress)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString ByteString
"addr=" Parser ByteString ByteString
-> Parser ByteString TransportHost
-> Parser ByteString TransportHost
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString TransportHost
forall a. StrEncoding a => Parser a
strP) Parser ByteString (Text -> RCCtrlAddress)
-> Parser ByteString Text -> Parser ByteString RCCtrlAddress
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ByteString
" iface=" Parser ByteString ByteString
-> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString Text
forall a. FromJSON a => Parser a
jsonP Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Text
text1P))
    text1P :: Parser ByteString Text
text1P = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
    char_ :: Char -> Parser ByteString (Maybe Char)
char_ = Parser ByteString Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString Char -> Parser ByteString (Maybe Char))
-> (Char -> Parser ByteString Char)
-> Char
-> Parser ByteString (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Parser ByteString Char
A.char

displayNameP :: Parser Text
displayNameP :: Parser ByteString Text
displayNameP = ByteString -> Text
safeDecodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
displayNameP_
{-# INLINE displayNameP #-}

displayNameP_ :: Parser ByteString
displayNameP_ :: Parser ByteString ByteString
displayNameP_ = Char -> Parser ByteString ByteString
quoted Char
'\'' Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString ByteString
takeNameTill (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',')
  where
    takeNameTill :: (Char -> Bool) -> Parser ByteString ByteString
takeNameTill Char -> Bool
p =
      Parser ByteString Char
A.peekChar' Parser ByteString Char
-> (Char -> Parser ByteString ByteString)
-> Parser ByteString ByteString
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c ->
        if Char -> Bool
refChar Char
c then (Char -> Bool) -> Parser ByteString ByteString
A.takeTill Char -> Bool
p else String -> Parser ByteString ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid first character in display name"
    quoted :: Char -> Parser ByteString ByteString
quoted Char
c = Char -> Parser ByteString Char
A.char Char
c Parser ByteString Char
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser ByteString ByteString
takeNameTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Parser ByteString ByteString
-> Parser ByteString Char -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
A.char Char
c
    refChar :: Char -> Bool
refChar Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''

mkValidName :: String -> String
mkValidName :: String -> String
mkValidName = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
50 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Char, Int) -> String
forall {a} {b} {c}. (a, b, c) -> a
fst3 ((String, Char, Int) -> String)
-> (String -> (String, Char, Int)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Char, Int) -> Char -> (String, Char, Int))
-> (String, Char, Int) -> String -> (String, Char, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (String, Char, Int) -> Char -> (String, Char, Int)
forall {c}.
(Ord c, Num c) =>
(String, Char, c) -> Char -> (String, Char, c)
addChar (String
"", Char
'\NUL', Int
0 :: Int)
  where
    fst3 :: (a, b, c) -> a
fst3 (a
x, b
_, c
_) = a
x
    addChar :: (String, Char, c) -> Char -> (String, Char, c)
addChar (String
r, Char
prev, c
punct) Char
c = if Bool
validChar then (Char
c' Char -> String -> String
forall a. a -> [a] -> [a]
: String
r, Char
c', c
punct') else (String
r, Char
prev, c
punct)
      where
        c' :: Char
c' = if Char -> Bool
isSpace Char
c then Char
' ' else Char
c
        punct' :: c
punct'
          | Char -> Bool
isPunctuation Char
c = c
punct c -> c -> c
forall a. Num a => a -> a -> a
+ c
1
          | Char -> Bool
isSpace Char
c = c
punct
          | Bool
otherwise = c
0
        validChar :: Bool
validChar
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' = Bool
False
          | Char
prev Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL' = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'@' Bool -> Bool -> Bool
&& Bool
validFirstChar
          | Char -> Bool
isSpace Char
prev = Bool
validFirstChar Bool -> Bool -> Bool
|| (c
punct c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
0 Bool -> Bool -> Bool
&& Char -> Bool
isPunctuation Char
c)
          | Char -> Bool
isPunctuation Char
prev = Bool
validFirstChar Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| (c
punct c -> c -> Bool
forall a. Ord a => a -> a -> Bool
< c
3 Bool -> Bool -> Bool
&& Char -> Bool
isPunctuation Char
c)
          | Bool
otherwise = Bool
validFirstChar Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isMark Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c
        validFirstChar :: Bool
validFirstChar = Char -> Bool
isLetter Char
c Bool -> Bool -> Bool
|| Char -> Bool
isNumber Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c