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