@@ -0,0 +1,111 @@
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
8+
9+module Main (main) where
10+
11+import Control.Concurrent (threadDelay, killThread, forkIO)
12+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)
13+import Control.Monad.IO.Class (liftIO)
14+import Data.Function ((&))
15+import Data.Word (Word8)
16+import Network.Socket (Socket, PortNumber)
17+import Streamly.Internal.Control.Monad (discard)
18+import Streamly.Prelude (SerialT)
19+import Test.QuickCheck (Property)
20+import Test.QuickCheck.Monadic (monadicIO, assert, run)
21+
22+import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as A
23+import qualified Streamly.Internal.Data.Unfold as UF
24+import qualified Streamly.Internal.Network.Inet.TCP as TCP
25+import qualified Streamly.Internal.Network.Socket as SK
26+import qualified Streamly.Internal.Unicode.Stream as U
27+import qualified Streamly.Prelude as S
28+
29+import Test.Hspec
30+import Test.Hspec.QuickCheck
31+
32+------------------------------------------------------------------------------
33+-- Command Handlers
34+------------------------------------------------------------------------------
35+testData :: String
36+testData = "Test data 1234567891012131415!@#$%^&*()`~ABCD"
37+
38+testDataLarge :: String
39+testDataLarge = (concat $ replicate 1000 testData)
40+
41+------------------------------------------------------------------------------
42+-- Read and Write data on a socket
43+------------------------------------------------------------------------------
44+handlerRW :: Socket -> IO ()
45+handlerRW sk =
46+ S.unfold SK.read sk
47+ & S.fold (SK.write sk)
48+ & discard
49+
50+------------------------------------------------------------------------------
51+-- Accept connecttions and handle connected sockets
52+------------------------------------------------------------------------------
53+server
54+ :: UF.Unfold IO PortNumber Socket
55+ -> PortNumber
56+ -> MVar ()
57+ -> (Socket -> IO ())
58+ -> IO ()
59+server addr port sem handler = do
60+ putMVar sem ()
61+ (S.serially $ S.unfold addr port)
62+ & (S.asyncly . S.mapM (SK.handleWithM handler))
63+ & S.drain
64+
65+remoteAddr :: (Word8,Word8,Word8,Word8)
66+remoteAddr = (127, 0, 0, 1)
67+
68+sender :: PortNumber -> MVar () -> SerialT IO Char
69+sender port sem = do
70+ _ <- liftIO $ takeMVar sem
71+ liftIO $ threadDelay 1000000 -- wait for server
72+ S.replicate 1 testDataLarge -- SerialT IO String
73+ & U.unwords UF.fromList -- SerialT IO Char
74+ & U.encodeLatin1 -- SerialT IO Word8
75+ & TCP.transformBytesWith remoteAddr port -- SerialT IO Word8
76+ & U.decodeLatin1 -- SerialT IO Char
77+
78+execute
79+ :: UF.Unfold IO PortNumber Socket
80+ -> PortNumber
81+ -> Int
82+ -> (Socket -> IO ())
83+ -> IO [Char]
84+execute addr port size handler = do
85+ sem <- newEmptyMVar
86+ tid <- forkIO $ server addr port sem handler
87+ lst <- sender port sem
88+ & S.take size
89+ & S.toList
90+ killThread tid
91+ return $ lst
92+
93+validateOnPort :: Property
94+validateOnPort = monadicIO $ do
95+ ls2 <- run $ execute TCP.acceptOnPort 8000 A.defaultChunkSize handlerRW
96+ assert (take A.defaultChunkSize testDataLarge == ls2)
97+
98+validateOnPortLocal :: Property
99+validateOnPortLocal = monadicIO $ do
100+ ls2 <-
101+ run
102+ $ execute TCP.acceptOnPortLocal 8001 A.defaultChunkSize handlerRW
103+ assert (take A.defaultChunkSize testDataLarge == ls2)
104+
105+main :: IO ()
106+main = hspec $ do
107+ modifyMaxSuccess (const 1) $ do
108+ describe "TCP Tests: " $ do
109+ prop "acceptOnPort" validateOnPort
110+ prop "acceptOnPortLocal" validateOnPortLocal
111+ -- prop "acceptOnAddr/connect" Tested as part of above test cases