summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Presence/Server.hs8
-rw-r--r--xmppServer.hs3
2 files changed, 5 insertions, 6 deletions
diff --git a/Presence/Server.hs b/Presence/Server.hs
index 1d586900..e5ceaf2d 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -482,8 +482,8 @@ connectionThreads h pinglogic = do
482 let finished e = do 482 let finished e = do
483 hClose h 483 hClose h
484 -- warn $ "finished read: " <> bshow (fmap ioeGetErrorType e) 484 -- warn $ "finished read: " <> bshow (fmap ioeGetErrorType e)
485 let _ = fmap ioeGetErrorType e -- type hint 485 -- let _ = fmap ioeGetErrorType e -- type hint
486 -- let _ = fmap what e where what (SomeException _) = undefined 486 let _ = fmap what e where what (SomeException _) = undefined
487 atomically $ do tryTakeTMVar outs 487 atomically $ do tryTakeTMVar outs
488 putTMVar outs Nothing -- quit writer 488 putTMVar outs Nothing -- quit writer
489 putTMVar doner () 489 putTMVar doner ()
@@ -498,8 +498,8 @@ connectionThreads h pinglogic = do
498 498
499 writerThread <- forkIO . fix $ \loop -> do 499 writerThread <- forkIO . fix $ \loop -> do
500 let finished = do -- warn $ "finished write" 500 let finished = do -- warn $ "finished write"
501 hClose h -- quit reader 501 -- hClose h -- quit reader
502 -- throwTo readerThread (ErrorCall "EOF") 502 throwTo readerThread (ErrorCall "EOF")
503 atomically $ putTMVar donew () 503 atomically $ putTMVar donew ()
504 mb <- atomically $ readTMVar outs 504 mb <- atomically $ readTMVar outs
505 case mb of Just bs -> handle (\(SomeException e)->finished) 505 case mb of Just bs -> handle (\(SomeException e)->finished)
diff --git a/xmppServer.hs b/xmppServer.hs
index 48745e51..e8864706 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -160,10 +160,9 @@ forkConnection k pingflag src snk stanzas = do
160 Just xml -> do 160 Just xml -> do
161 atomically $ Slotted.push slots Nothing xml 161 atomically $ Slotted.push slots Nothing xml
162 inner 162 inner
163 Nothing -> return ()) 163 Nothing -> loop)
164 (readTMVar rdone >> return (return ())) 164 (readTMVar rdone >> return (return ()))
165 what 165 what
166 loop
167 ,do pingflag >>= check 166 ,do pingflag >>= check
168 return $ do 167 return $ do
169 wlog $ "TODO: send ping" 168 wlog $ "TODO: send ping"