mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-30 22:55:50 +00:00
85 lines
2.5 KiB
Haskell
85 lines
2.5 KiB
Haskell
{-# LANGUAGE BlockArguments #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module SMPClient where
|
|
|
|
import Control.Monad.IO.Unlift
|
|
import Crypto.Random
|
|
import Network.Socket
|
|
import Simplex.Messaging.Protocol
|
|
import Simplex.Messaging.Server
|
|
import Simplex.Messaging.Server.Env.STM
|
|
import Simplex.Messaging.Transport
|
|
import Test.Hspec
|
|
import UnliftIO.Concurrent
|
|
import qualified UnliftIO.Exception as E
|
|
import UnliftIO.IO
|
|
|
|
testHost :: HostName
|
|
testHost = "localhost"
|
|
|
|
testPort :: ServiceName
|
|
testPort = "5000"
|
|
|
|
testSMPClient :: MonadUnliftIO m => (Handle -> m a) -> m a
|
|
testSMPClient client = do
|
|
threadDelay 5000 -- TODO hack: thread delay for SMP server to start
|
|
runTCPClient testHost testPort $ \h -> do
|
|
line <- liftIO $ getLn h
|
|
if line == "Welcome to SMP v0.2.0"
|
|
then client h
|
|
else error "not connected"
|
|
|
|
cfg :: ServerConfig
|
|
cfg =
|
|
ServerConfig
|
|
{ tcpPort = testPort,
|
|
tbqSize = 1,
|
|
queueIdBytes = 12,
|
|
msgIdBytes = 6
|
|
}
|
|
|
|
withSmpServerThreadOn :: (MonadUnliftIO m, MonadRandom m) => ServiceName -> (ThreadId -> m a) -> m a
|
|
withSmpServerThreadOn port =
|
|
E.bracket
|
|
(forkIO $ runSMPServer cfg {tcpPort = port})
|
|
(liftIO . killThread)
|
|
|
|
withSmpServerOn :: (MonadUnliftIO m, MonadRandom m) => ServiceName -> m a -> m a
|
|
withSmpServerOn port = withSmpServerThreadOn port . const
|
|
|
|
withSmpServer :: (MonadUnliftIO m, MonadRandom m) => m a -> m a
|
|
withSmpServer = withSmpServerOn testPort
|
|
|
|
runSmpTest :: (MonadUnliftIO m, MonadRandom m) => (Handle -> m a) -> m a
|
|
runSmpTest test = withSmpServer $ testSMPClient test
|
|
|
|
runSmpTestN :: forall m a. (MonadUnliftIO m, MonadRandom m) => Int -> ([Handle] -> m a) -> m a
|
|
runSmpTestN nClients test = withSmpServer $ run nClients []
|
|
where
|
|
run :: Int -> [Handle] -> m a
|
|
run 0 hs = test hs
|
|
run n hs = testSMPClient $ \h -> run (n - 1) (h : hs)
|
|
|
|
smpServerTest :: RawTransmission -> IO RawTransmission
|
|
smpServerTest cmd = runSmpTest $ \h -> tPutRaw h cmd >> tGetRaw h
|
|
|
|
smpTest :: (Handle -> IO ()) -> Expectation
|
|
smpTest test' = runSmpTest test' `shouldReturn` ()
|
|
|
|
smpTestN :: Int -> ([Handle] -> IO ()) -> Expectation
|
|
smpTestN n test' = runSmpTestN n test' `shouldReturn` ()
|
|
|
|
smpTest2 :: (Handle -> Handle -> IO ()) -> Expectation
|
|
smpTest2 test' = smpTestN 2 _test
|
|
where
|
|
_test [h1, h2] = test' h1 h2
|
|
_test _ = error "expected 2 handles"
|
|
|
|
smpTest3 :: (Handle -> Handle -> Handle -> IO ()) -> Expectation
|
|
smpTest3 test' = smpTestN 3 _test
|
|
where
|
|
_test [h1, h2, h3] = test' h1 h2 h3
|
|
_test _ = error "expected 3 handles"
|