diff options
| -rw-r--r-- | src/Erebos/Network/Protocol.hs | 24 | ||||
| -rw-r--r-- | test/discovery.test | 7 | ||||
| -rw-r--r-- | test/network.test | 15 |
3 files changed, 38 insertions, 8 deletions
diff --git a/src/Erebos/Network/Protocol.hs b/src/Erebos/Network/Protocol.hs index bd640ac..f67e296 100644 --- a/src/Erebos/Network/Protocol.hs +++ b/src/Erebos/Network/Protocol.hs @@ -250,6 +250,12 @@ instance Eq (Connection addr) where connAddress :: Connection addr -> addr connAddress = cAddress +showConnAddress :: forall addr. Connection addr -> String +showConnAddress Connection {..} = helper cGlobalState cAddress + where + helper :: GlobalState addr -> addr -> String + helper GlobalState {} = show + connData :: Connection addr -> Flow (Maybe (Bool, TransportPacket PartialObject)) (SecurityRequirement, TransportPacket Ref, [TransportHeaderItem]) @@ -274,6 +280,7 @@ connClose conn@Connection {..} = do connAddWriteStream :: Connection addr -> STM (Either String (TransportHeaderItem, RawStreamWriter, IO ())) connAddWriteStream conn@Connection {..} = do + let GlobalState {..} = cGlobalState outStreams <- readTVar cOutStreams let doInsert :: Word8 -> [(Word8, Stream)] -> ExceptT String STM ((Word8, Stream), [(Word8, Stream)]) doInsert n (s@(n', _) : rest) | n == n' = @@ -290,14 +297,16 @@ connAddWriteStream conn@Connection {..} = do runExceptT $ do ((streamNumber, stream), outStreams') <- doInsert 1 outStreams lift $ writeTVar cOutStreams outStreams' + lift $ gTestLog $ "net-ostream-open " <> showConnAddress conn <> " " <> show streamNumber <> " " <> show (length outStreams') return ( StreamOpen streamNumber , RawStreamWriter (fromIntegral streamNumber) (sFlowIn stream) - , go cGlobalState streamNumber stream + , go streamNumber stream ) where - go gs@GlobalState {..} streamNumber stream = do + go streamNumber stream = do + let GlobalState {..} = cGlobalState (reserved, msg) <- atomically $ do readTVar (sState stream) >>= \case StreamRunning -> return () @@ -310,6 +319,8 @@ connAddWriteStream conn@Connection {..} = do return (stpData, True, return ()) StreamClosed {} -> do atomically $ do + gTestLog $ "net-ostream-close-send " <> showConnAddress conn <> " " <> show streamNumber + atomically $ do -- wait for ack on all sent stream data waits <- readTVar (sWaitingForAck stream) when (waits > 0) retry @@ -353,7 +364,7 @@ connAddWriteStream conn@Connection {..} = do sendBytes conn mbReserved' bs Nothing -> return () - when cont $ go gs streamNumber stream + when cont $ go streamNumber stream connAddReadStream :: Connection addr -> Word8 -> STM RawStreamReader connAddReadStream Connection {..} streamNumber = do @@ -412,8 +423,10 @@ streamAccepted Connection {..} snum = atomically $ do Nothing -> return () streamClosed :: Connection addr -> Word8 -> IO () -streamClosed Connection {..} snum = atomically $ do - modifyTVar' cOutStreams $ filter ((snum /=) . fst) +streamClosed conn@Connection {..} snum = atomically $ do + streams <- filter ((snum /=) . fst) <$> readTVar cOutStreams + writeTVar cOutStreams streams + gTestLog cGlobalState $ "net-ostream-close-ack " <> showConnAddress conn <> " " <> show snum <> " " <> show (length streams) readStreamToList :: RawStreamReader -> IO (Word64, [(Word64, BC.ByteString)]) readStreamToList stream = readFlowIO (rsrFlow stream) >>= \case @@ -563,6 +576,7 @@ newConnection cGlobalState@GlobalState {..} addr = do cOutStreams <- newTVar [] let conn = Connection {..} + gTestLog $ "net-conn-new " <> show cAddress writeTVar gConnections (conn : conns) return conn diff --git a/test/discovery.test b/test/discovery.test index 4b48d8b..a297f54 100644 --- a/test/discovery.test +++ b/test/discovery.test @@ -124,7 +124,7 @@ test DiscoveryTunnel: for id in [ p1obase ]: for p in [ pd, p1, p2 ]: - send "start-server services $services" to p + send "start-server services $services test-log" to p for p in [ p1, p2 ]: with p: @@ -138,6 +138,11 @@ test DiscoveryTunnel: send "discovery-tunnel 1 $id" to p2 + expect /net-ostream-open ${pd.node.ip} 29665 1 1/ from p2 + expect /net-ostream-open ${p1.node.ip} 29665 1 1/ from pd + expect /net-ostream-open ${pd.node.ip} 29665 1 1/ from p1 + expect /net-ostream-open ${p2.node.ip} 29665 1 1/ from pd + expect from p1: /peer [0-9]+ addr tunnel@.*/ /peer [0-9]+ id Device2 Owner2/ diff --git a/test/network.test b/test/network.test index 0f49a1e..a670f35 100644 --- a/test/network.test +++ b/test/network.test @@ -189,8 +189,8 @@ test ServiceStreams: spawn as p2 send "create-identity Device1" to p1 send "create-identity Device2" to p2 - send "start-server services $services" to p1 - send "start-server services $services" to p2 + send "start-server services $services test-log" to p1 + send "start-server services $services test-log" to p2 expect from p1: /peer 1 addr ${p2.node.ip} 29665/ /peer 1 id Device2/ @@ -202,6 +202,8 @@ test ServiceStreams: expect /test-stream-open-done 1 ([0-9]+)/ from p1 capture stream1 expect /test-stream-open-from 1 $stream1/ from p2 + expect /net-ostream-open ${p2.node.ip} 29665 1 1/ from p1 + send "test-stream-send 1 $stream1 hello" to p1 expect /test-stream-send-done 1 $stream1/ from p1 expect /test-stream-received 1 $stream1 0 hello/ from p2 @@ -210,12 +212,18 @@ test ServiceStreams: expect /test-stream-close-done 1 $stream1/ from p1 expect /test-stream-closed-from 1 $stream1 1/ from p2 + expect /net-ostream-close-send ${p2.node.ip} 29665 1/ from p1 + expect /net-ostream-close-ack ${p2.node.ip} 29665 1 0/ from p1 + send "test-stream-open 1 8" to p2 expect /test-stream-open-done 1 ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+)/ from p2 capture stream2_1, stream2_2, stream2_3, stream2_4, stream2_5, stream2_6, stream2_7, stream2_8 expect /test-stream-open-from 1 $stream2_1 $stream2_2 $stream2_3 $stream2_4 $stream2_5 $stream2_6 $stream2_7 $stream2_8/ from p1 let streams2 = [ stream2_1, stream2_2, stream2_3, stream2_4, stream2_5, stream2_6, stream2_7, stream2_8 ] with p2: + expect /net-ostream-open ${p1.node.ip} 29665 . 8/ + flush matching /net-ostream-open ${p1.node.ip} 29665.*/ + for i in [ 1..20 ]: for s in streams2: send "test-stream-send 1 $s hello$i" @@ -226,6 +234,9 @@ test ServiceStreams: send "test-stream-close 1 $s" for s in streams2: expect /test-stream-close-done 1 $s/ + + expect /net-ostream-close-ack ${p1.node.ip} 29665 . 0/ + flush matching /net-ostream-close-[a-z]* ${p1.node.ip} 29665.*/ with p1: for i in [ 1..20 ]: for s in streams2: |