chat test with VirtualTerminal (#72)

* chat test with VirtualTerminal

* disable chat test

* fix intermittently failing test

* simplify test
This commit is contained in:
Evgeny Poberezkin
2021-07-07 22:46:38 +01:00
committed by GitHub
parent 25ac250d37
commit d21abbdec1
10 changed files with 230 additions and 72 deletions
-9
View File
@@ -2,7 +2,6 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Controller where
@@ -11,7 +10,6 @@ import Control.Exception
import Control.Monad.Except
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Numeric.Natural
import Simplex.Chat.Notification
import Simplex.Chat.Store (StoreError)
import Simplex.Chat.Terminal
@@ -45,13 +43,6 @@ data ContactError = CENotFound ContactRef | CEProfile String
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
newChatController :: AgentClient -> ChatTerminal -> SQLiteStore -> User -> (Notification -> IO ()) -> Natural -> STM ChatController
newChatController smpAgent chatTerminal chatStore currentUser sendNotification qSize = do
inputQ <- newTBQueue qSize
notifyQ <- newTBQueue qSize
-- chatQ <- newTBQueue qSize
pure ChatController {currentUser, smpAgent, chatTerminal, chatStore, inputQ, notifyQ, sendNotification}
setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
setActive to = asks (activeTo . chatTerminal) >>= atomically . (`writeTVar` to)