voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

and it works

This commit is contained in:
Dmitry Zuikov 2023-01-17 07:31:36 +03:00
parent 65f95fd3fb
commit a9f0141f87
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
hbs2-core/test/TestUniqProtoId.hs
View File

@ -12,8 +12,12 @@ import Data.ByteString.Lazy (ByteString)
import Control.Concurrent.Async import Control.Concurrent.Async
import Codec.Serialise hiding (encode,decode) import Codec.Serialise hiding (encode,decode)
import System.IO
import Prettyprinter hiding (pipe) import Prettyprinter hiding (pipe)
debug :: (MonadIO m) => Doc ann -> m ()
debug p = liftIO $ hPrint stderr p
data PingPong e = Ping Int data PingPong e = Ping Int
| Pong Int | Pong Int
@ -50,8 +54,8 @@ pingPongHandler :: forall e m . ( MonadIO m
pingPongHandler = pingPongHandler =
\case \case
Ping c -> liftIO (print $ "effect: PING" <+> pretty c) >> response (Pong @e c) Ping c -> debug ("effect: PING" <+> pretty c) >> response (Pong @e c)
Pong c -> liftIO (print $ "effect: PONG" <+> pretty c) >> response (Ping @e (succ c)) Pong c -> debug ( "effect: PONG" <+> pretty c) >> response (Ping @e (succ c))
peekPokeHandler :: forall e m . ( MonadIO m peekPokeHandler :: forall e m . ( MonadIO m
, Response e (PeekPoke e) m , Response e (PeekPoke e) m
@ -62,14 +66,16 @@ peekPokeHandler :: forall e m . ( MonadIO m
peekPokeHandler = peekPokeHandler =
\case \case
Peek c -> liftIO (print $ "effect: Peek" <+> pretty c) >> response (Poke @e c) Peek c -> debug ("effect: Peek" <+> pretty c) >> response (Poke @e c)
Poke c -> liftIO (print $ "effect: Poke" <+> pretty c) >> response (Nop @e) Poke c -> debug ("effect: Poke" <+> pretty c) >> response (Nop @e)
Nop -> liftIO (print $ pretty "effect: Nop") >> response (Peek @e 1) Nop -> debug "effect: Nop" >> response (Peek @e 1)
testUniqProtoId :: IO () testUniqProtoId :: IO ()
testUniqProtoId = do testUniqProtoId = do
hSetBuffering stderr LineBuffering
fake <- newFakeP2P True fake <- newFakeP2P True
let peer0 = FakePeer 0 let peer0 = FakePeer 0