git.iko.soy/streamly
on 604f430 help sign in
streamly/test/Streamly/Test/Network/Inet/TCP.hs
137 lines 4.9 kB history raw
1-- |
2-- Module : Streamly.Test.Network.Socket
3-- Copyright : (c) 2020 Composewell technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
9module Main (main) where
11import Control.Concurrent (threadDelay, killThread, forkIO)
12import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
13import Control.Monad.IO.Class (liftIO)
14import Data.Function ((&))
15import Data.Word (Word8)
16import Network.Socket (Socket, PortNumber)
17import Streamly.Internal.Control.Monad (discard)
18import Streamly.Prelude (SerialT)
19import Test.QuickCheck (Property)
20import Test.QuickCheck.Monadic (monadicIO, assert, run)
22import qualified Streamly.Internal.Data.Array.Foreign.Type as Array
23import qualified Streamly.Internal.Data.Unfold as Unfold
24import qualified Streamly.Internal.Network.Inet.TCP as TCP
25import qualified Streamly.Internal.Network.Socket as Socket
26import qualified Streamly.Internal.Unicode.Stream as Unicode
27import qualified Streamly.Prelude as Stream
29import Test.Hspec
30import Test.Hspec.QuickCheck
32------------------------------------------------------------------------------
33-- Command Handlers
34------------------------------------------------------------------------------
35testData :: String
36testData = "Test data 1234567891012131415!@#$%^&*()`~ABCD"
38testDataSource :: String
39testDataSource = concat $ replicate 1000 testData
41------------------------------------------------------------------------------
42-- Read and Write data on a socket
43------------------------------------------------------------------------------
44handlerRW :: Socket -> IO ()
45handlerRW sk =
46 Stream.unfold Socket.read sk
47 & Stream.fold (Socket.write sk)
48 & discard
50------------------------------------------------------------------------------
51-- Accept connections and handle connected sockets
52------------------------------------------------------------------------------
54-- Ideally we should choose an available port automatically. However, to test
55-- the APIs that do not allow choosing a port automatically we still need to
56-- use a hardcoded port or search an available port on the system.
57--
58-- This is unreliable and the test may fail on systems where this port is not
59-- available. We choose a higher port number so that the likelihood of it being
60-- available is more.
61--
62-- Also, we cannot run the test after running it once until the timeout.
63basePort :: PortNumber
64basePort = 64100
66server
67 :: Unfold.Unfold IO PortNumber Socket
68 -> PortNumber
69 -> MVar ()
70 -> (Socket -> IO ())
71 -> IO ()
72server listener port sem handler = do
73 putMVar sem ()
74 Stream.fromSerial (Stream.unfold listener port)
75 & (Stream.fromAsync . Stream.mapM (Socket.forSocketM handler))
76 & Stream.drain
78remoteAddr :: (Word8,Word8,Word8,Word8)
79remoteAddr = (127, 0, 0, 1)
81sender :: PortNumber -> MVar () -> SerialT IO Char
82sender port sem = do
83 _ <- liftIO $ takeMVar sem
84 liftIO $ threadDelay 1000000 -- wait for server
85 Stream.replicate 1000 testData -- SerialT IO String
86 & Stream.concatMap Stream.fromList -- SerialT IO Char
87 & Unicode.encodeLatin1 -- SerialT IO Word8
88 & TCP.processBytes remoteAddr port -- SerialT IO Word8
89 & Unicode.decodeLatin1 -- SerialT IO Char
91execute
92 :: Unfold.Unfold IO PortNumber Socket
93 -> PortNumber
94 -> Int
95 -> (Socket -> IO ())
96 -> IO (SerialT IO Char)
97execute listener port size handler = do
98 sem <- newEmptyMVar
99 tid <- forkIO $ server listener port sem handler
100 let lst = sender port sem
101 & Stream.take size
102 & Stream.finally (killThread tid)
103 return lst
105validateOnPort :: Property
106validateOnPort = monadicIO $ do
107 res <- run $ do
108 ls2 <-
109 execute TCP.acceptOnPort basePort Array.defaultChunkSize handlerRW
110 let dataChunk = take Array.defaultChunkSize testDataSource
111 Stream.eqBy (==) (Stream.fromList dataChunk) ls2
112 assert res
114validateOnPortLocal :: Property
115validateOnPortLocal = monadicIO $ do
116 res <- run $ do
117 ls2 <-
118 execute
119 TCP.acceptOnPortLocal
120 (basePort + 1)
121 Array.defaultChunkSize
122 handlerRW
123 let dataChunk = take Array.defaultChunkSize testDataSource
124 Stream.eqBy (==) (Stream.fromList dataChunk) ls2
125 assert res
127moduleName :: String
128moduleName = "Network.Inet.TCP"
130main :: IO ()
131main = hspec $ do
132 modifyMaxSuccess (const 1) $ do
133 describe moduleName $ do
134 describe "Accept Connections" $ do
135 prop "acceptOnPort" validateOnPort
136 prop "acceptOnPortLocal" validateOnPortLocal
137 -- prop "acceptOnAddr/connect" Tested as part of above test cases