Added ConnectFail event

1 files changed, 10 insertions, 1 deletions

diff --git a/Presence/Server.hs b/Presence/Server.hs
index e5ceaf2d..4cbaaa7d 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -145,6 +145,8 @@ data ConnectionEvent b
     -- ^ Arrival of data from a socket
     | Connection (STM Bool) (IO (Maybe ByteString)) (ByteString -> IO Bool)
     -- ^ A new connection was established
+    | ConnectFailure SockAddr
+    -- ^ A 'Connect' command failed.
     | HalfConnection InOrOut
     -- ^ Half of a half-duplex connection is avaliable.
     | EOF 
@@ -267,7 +269,14 @@ server = do
         proto <- getProtocolNumber "tcp"
         sock <- bracketOnError
             (socket (socketFamily addr) Stream proto)
-            (sClose . trace "connect-error" )  -- only done if there's an error
+            (\sock -> do -- only done if there's an error
+                         -- Weird hack: puting the would-be peer address
+                         -- instead of local socketName
+                         conkey <- makeConnKey params (sock,addr) -- XXX: ?
+                         sClose sock
+                         atomically 
+                            $ writeTChan (serverEvent server) 
+                                $ (conkey,ConnectFailure addr))
             $ \sock -> do connect sock addr
                           return sock
         me <- getSocketName sock