diff options
Diffstat (limited to 'Presence/ServerC.hs')
-rw-r--r-- | Presence/ServerC.hs | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/Presence/ServerC.hs b/Presence/ServerC.hs index b16a0099..22104a31 100644 --- a/Presence/ServerC.hs +++ b/Presence/ServerC.hs | |||
@@ -8,6 +8,7 @@ module ServerC | |||
8 | , ServerHandle | 8 | , ServerHandle |
9 | , quitListening | 9 | , quitListening |
10 | , dummyServerHandle | 10 | , dummyServerHandle |
11 | , packetSink | ||
11 | ) where | 12 | ) where |
12 | 13 | ||
13 | import Network.Socket as Socket | 14 | import Network.Socket as Socket |
@@ -123,13 +124,13 @@ packets h = do | |||
123 | where | 124 | where |
124 | getPacket h = do { hWaitForInput h (-1) ; hGetNonBlocking h 1024 } | 125 | getPacket h = do { hWaitForInput h (-1) ; hGetNonBlocking h 1024 } |
125 | 126 | ||
126 | outgoing :: MonadIO m => Handle -> Sink S.ByteString m () | 127 | packetSink :: MonadIO m => Handle -> Sink S.ByteString m () |
127 | outgoing h = do | 128 | packetSink h = do |
128 | -- liftIO . L.putStrLn $ "outgoing: waiting" | 129 | -- liftIO . L.putStrLn $ "outgoing: waiting" |
129 | mpacket <- await | 130 | mpacket <- await |
130 | -- liftIO . L.putStrLn $ "outgoing: got packet " <++> bshow mpacket | 131 | -- liftIO . L.putStrLn $ "outgoing: got packet " <++> bshow mpacket |
131 | maybe (return ()) | 132 | maybe (return ()) |
132 | (\r -> (liftIO . S.hPutStrLn h $ r) >> outgoing h) | 133 | (\r -> (liftIO . S.hPutStrLn h $ r) >> packetSink h) |
133 | mpacket | 134 | mpacket |
134 | 135 | ||
135 | 136 | ||
@@ -148,5 +149,5 @@ runConn g st (sock,_) = do | |||
148 | h <- socketToHandle sock ReadWriteMode | 149 | h <- socketToHandle sock ReadWriteMode |
149 | hSetBuffering h NoBuffering | 150 | hSetBuffering h NoBuffering |
150 | let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n") | 151 | let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n") |
151 | handle doException (g (restrictSocket sock `HCons` st) (packets h) (outgoing h)) | 152 | handle doException (g (restrictSocket sock `HCons` st) (packets h) (packetSink h)) |
152 | hClose h | 153 | hClose h |