summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Presence/XMPPServer.hs13
1 files changed, 6 insertions, 7 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index be59ac02..3684925a 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -588,7 +588,7 @@ sendMessage cons msg peer = do
588 readTVar cons >>= writeTVar cons . Map.insert peer entry 588 readTVar cons >>= writeTVar cons . Map.insert peer entry
589 589
590connect_to_server chan peer = (>> return ()) . runMaybeT $ do 590connect_to_server chan peer = (>> return ()) . runMaybeT $ do
591 let port = "5269" 591 let port = 5269 :: Int
592 592
593 connected <- liftIO . async $ connect' (peerAddr peer) port 593 connected <- liftIO . async $ connect' (peerAddr peer) port
594 594
@@ -695,8 +695,8 @@ socketFamily (SockAddrInet _ _) = AF_INET
695socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 695socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6
696socketFamily (SockAddrUnix _) = AF_UNIX 696socketFamily (SockAddrUnix _) = AF_UNIX
697 697
698connect' :: SockAddr -> ServiceName -> IO (Maybe Socket) 698connect' :: SockAddr -> Int -> IO (Maybe Socket)
699connect' addr serv = do 699connect' addr port = do
700 proto <- getProtocolNumber "tcp" 700 proto <- getProtocolNumber "tcp"
701 {- 701 {-
702 -- Given (host :: HostName) ... 702 -- Given (host :: HostName) ...
@@ -708,14 +708,13 @@ connect' addr serv = do
708 -} 708 -}
709 let getport (SockAddrInet port _) = port 709 let getport (SockAddrInet port _) = port
710 getport (SockAddrInet6 port _ _ _) = port 710 getport (SockAddrInet6 port _ _ _) = port
711 let port = getport addr 711 let withPort (SockAddrInet _ a) port = SockAddrInet (toEnum port) a
712 let withPort (SockAddrInet _ a) port = SockAddrInet port a 712 withPort (SockAddrInet6 _ a b c) port = SockAddrInet6 (toEnum port) a b c
713 withPort (SockAddrInet6 _ a b c) port = SockAddrInet6 port a b c
714 let doException (SomeException e) = do 713 let doException (SomeException e) = do
715 L.putStrLn $ "\nFailed to reach "<++> showPeer (RemotePeer addr) <++> " on port "<++>bshow port<++>": " <++> bshow e 714 L.putStrLn $ "\nFailed to reach "<++> showPeer (RemotePeer addr) <++> " on port "<++>bshow port<++>": " <++> bshow e
716 return Nothing 715 return Nothing
717 handle doException 716 handle doException
718 $ tryToConnect proto (addr `withPort` 5269) 717 $ tryToConnect proto (addr `withPort` port)
719 where 718 where
720 tryToConnect proto addr = 719 tryToConnect proto addr =
721 bracketOnError 720 bracketOnError