diff --git a/changes.md b/changes.md --- a/changes.md +++ b/changes.md @@ -1,3 +1,7 @@ +0.1.0.13 + + * Explicitly removed support for 7.4; 7.6 now required. + 0.1.0.12 * Fixed a long-standing issue concerning inconsistent failures. Turns out, on operating diff --git a/courier.cabal b/courier.cabal --- a/courier.cabal +++ b/courier.cabal @@ -1,5 +1,5 @@ name: courier -version: 0.1.0.12 +version: 0.1.0.13 synopsis: A message-passing library for simplifying network applications description: Inspired by Erlang's simple message-passing facilities, courier provides roughly similar capabilities. Applications simply create one or more endpoints, @@ -52,11 +52,11 @@ Control.Concurrent.Mailbox Network.RPC - ghc-options: -Wall + ghc-options: -Wall -fno-state-hack other-modules: Network.Transport.Sockets Network.Transport.Internal - build-depends: base >=4 && <5, + build-depends: base >=4.6 && <5, async, bytestring, cereal, diff --git a/src/Network/Transport/Sockets.hs b/src/Network/Transport/Sockets.hs --- a/src/Network/Transport/Sockets.hs +++ b/src/Network/Transport/Sockets.hs @@ -48,7 +48,8 @@ parseSocketAddress, lookupAddresses, - lookupAddress + lookupAddress, + lookupWildcardAddress ) where @@ -235,18 +236,26 @@ else h port p = p -lookupAddresses :: (HostName,ServiceName) -> IO [SockAddr] -lookupAddresses hostAndPort = - let (host,port) = hostAndPort +lookupAddresses :: Family -> SocketType -> Address -> IO [SockAddr] +lookupAddresses family socketType address = + let (host,port) = parseSocketAddress address hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME, AI_NUMERICSERV] } - in do + in do addresses <- getAddrInfo (Just hints) (Just host) (Just port) - return $ map addrAddress $ filter (\addrinfo -> addrFamily addrinfo == AF_INET) addresses + return $ map addrAddress $ filter (\addrInfo -> addrFamily addrInfo == family && addrSocketType addrInfo == socketType) addresses -lookupAddress :: (HostName,ServiceName) -> IO SockAddr -lookupAddress hostAndPort = do - addresses <- lookupAddresses hostAndPort +lookupAddress :: Family -> SocketType -> Address -> IO SockAddr +lookupAddress family socketType address = do + addresses <- lookupAddresses family socketType address return $ addresses !! 0 + +lookupWildcardAddress :: Family -> SocketType -> Address -> IO SockAddr +lookupWildcardAddress family socketType address = do + sockAddr <- lookupAddress family socketType address + case sockAddr of + SockAddrInet port _ -> return $ SockAddrInet port iNADDR_ANY + SockAddrInet6 port flow _ scope -> return $ SockAddrInet6 port flow iN6ADDR_ANY scope + _ -> return sockAddr type SocketSend = Socket -> B.ByteString -> IO () diff --git a/src/Network/Transport/TCP.hs b/src/Network/Transport/TCP.hs --- a/src/Network/Transport/TCP.hs +++ b/src/Network/Transport/TCP.hs @@ -53,6 +53,12 @@ tcpScheme :: Scheme tcpScheme = "tcp" +lookupTCPAddress :: Address -> IO NS.SockAddr +lookupTCPAddress address = lookupAddress NS.AF_INET NS.Stream address + +lookupWildcardTCPAddress :: Address -> IO NS.SockAddr +lookupWildcardTCPAddress address = lookupWildcardAddress NS.AF_INET NS.Stream address + {-| Create a new 'Transport' suitable for sending messages over TCP/IP. There can be multiple instances of these 'Transport's: 'Network.Endpoints.Endpoint' using @@ -107,14 +113,12 @@ unbind = tcpUnbind address } where - tcpListen address sock = do + tcpListen address sock = do catchExceptions (do - let (_,port) = parseSocketAddress address - portnums <- NS.getAddrInfo - (Just NS.defaultHints {NS.addrFlags = [NS.AI_PASSIVE,NS.AI_NUMERICSERV]}) Nothing (Just port) NS.setSocketOption sock NS.NoDelay 1 NS.setSocketOption sock NS.ReuseAddr 1 - NS.bind sock (NS.addrAddress $ head portnums) + sockAddr <- lookupWildcardTCPAddress address + NS.bind sock sockAddr NS.listen sock 2048) -- TODO think about a configurable backlog (\e -> do warningM _log $ "Listen error on port " ++ address ++ ": " ++ (show (e :: SomeException)) @@ -162,24 +166,16 @@ newTCPConnection :: Address -> IO Connection newTCPConnection address = do sock <- atomically $ newEmptyTMVar - let (host,port) = parseSocketAddress address return Connection { connAddress = address, connSocket = sock, connConnect = do socket <- NS.socket NS.AF_INET NS.Stream NS.defaultProtocol - sockAddrs <- NS.getAddrInfo - (Just NS.defaultHints {NS.addrFlags = [NS.AI_NUMERICSERV,NS.AI_ADDRCONFIG]}) (Just host) (Just port) - let ipv4Addrs = filter (\sockAddr -> - (NS.addrFamily sockAddr == NS.AF_INET) - && (NS.addrSocketType sockAddr == NS.Stream)) - sockAddrs - infoM _log $ "Socket addresses are " ++ (show sockAddrs) - infoM _log $ "IPv4 addresses are " ++ (show ipv4Addrs) - infoM _log $ "Initiating socket connection to " ++ (show $ head ipv4Addrs) - NS.connect socket $ NS.addrAddress $ head ipv4Addrs + sockAddr <- lookupTCPAddress address + NS.connect socket sockAddr + -- NS.connect socket $ NS.addrAddress $ head ipv4Addrs atomically $ putTMVar sock socket - infoM _log $ "Initiated socket connection to " ++ (show $ head ipv4Addrs) + -- infoM _log $ "Initiated socket connection to " ++ (show $ head ipv4Addrs) return socket, connSend = tcpSend address, connReceive = receiveSocketBytes, diff --git a/src/Network/Transport/UDP.hs b/src/Network/Transport/UDP.hs --- a/src/Network/Transport/UDP.hs +++ b/src/Network/Transport/UDP.hs @@ -45,7 +45,7 @@ import qualified Data.Map as M import qualified Data.Set as S -import qualified Network.Socket as N +import qualified Network.Socket as NS import Network.Socket.ByteString(sendAllTo,recvFrom) import System.Log.Logger @@ -60,6 +60,12 @@ udpScheme :: Scheme udpScheme = "udp" +lookupUDPAddress :: Address -> IO NS.SockAddr +lookupUDPAddress address = lookupAddress NS.AF_INET NS.Datagram address + +lookupWildcardUDPAddress :: Address -> IO NS.SockAddr +lookupWildcardUDPAddress address = lookupWildcardAddress NS.AF_INET NS.Datagram address + newUDPTransport :: Resolver -> IO Transport newUDPTransport resolver = do messengers <- atomically $ newTVar M.empty @@ -98,23 +104,13 @@ M.insert name inc bindings Just address <- resolve (socketResolver transport) name bindAddress sockets address $ do - let (_,port) = parseSocketAddress address - addrinfos <- N.getAddrInfo - (Just (N.defaultHints {N.addrFlags = [N.AI_PASSIVE,N.AI_NUMERICSERV]})) - Nothing (Just port) - let ipv4Addrs = filter (\sockAddr -> - (N.addrFamily sockAddr == N.AF_INET) - && (N.addrSocketType sockAddr == N.Datagram)) - addrinfos - infoM _log $ "Socket addresses are " ++ (show addrinfos) - infoM _log $ "IPv4 addresses are " ++ (show ipv4Addrs) - let serveraddr = head ipv4Addrs - sock <- N.socket (N.addrFamily serveraddr) N.Datagram N.defaultProtocol + sockaddr <- lookupWildcardUDPAddress address + sock <- NS.socket NS.AF_INET NS.Datagram NS.defaultProtocol -- have to set this option in case we frequently rebind sockets - infoM _log $ "Binding to " ++ (show port) ++ " over UDP" - N.setSocketOption sock N.ReuseAddr 1 - N.bindSocket sock $ N.addrAddress serveraddr - infoM _log $ "Bound to " ++ (show port) ++ " over UDP" + infoM _log $ "Binding to " ++ (show address) ++ " over UDP" + NS.setSocketOption sock NS.ReuseAddr 1 + NS.bindSocket sock sockaddr + infoM _log $ "Bound to " ++ (show address) ++ " over UDP" rcvr <- async $ udpReceiveSocketMessages sock address (socketInbound transport) return (sock,rcvr) return $ Right Binding { @@ -131,9 +127,9 @@ return Connection { connAddress = address, connSocket = sock, - connConnect = N.socket N.AF_INET N.Datagram N.defaultProtocol, + connConnect = NS.socket NS.AF_INET NS.Datagram NS.defaultProtocol, connSend = (\s bs -> do - addr <- lookupAddress $ parseSocketAddress address + addr <- lookupUDPAddress address infoM _log $ "Sending via UDP to " ++ (show addr) sendAllTo s bs addr infoM _log $ "Sent via UDP to " ++ (show addr)), @@ -141,7 +137,7 @@ connClose = do maybeSocket <- atomically $ tryTakeTMVar sock case maybeSocket of - Just s -> N.sClose s + Just s -> NS.sClose s Nothing -> return () return () } @@ -151,7 +147,7 @@ msngr <- newMessenger conn mailbox return msngr -udpReceiveSocketMessages :: N.Socket -> Address -> Mailbox Message -> IO () +udpReceiveSocketMessages :: NS.Socket -> Address -> Mailbox Message -> IO () udpReceiveSocketMessages sock addr mailbox = catchExceptions (do infoM _log $ "Waiting to receive via UDP on " ++ (show addr) @@ -159,7 +155,7 @@ infoM _log $ "Received message via UDP on " ++ (show addr) case maybeMsg of Nothing -> do - N.sClose sock + NS.sClose sock return () Just msg -> do atomically $ writeMailbox mailbox msg @@ -172,7 +168,7 @@ infoM _log $ "Received message" return maybeMsg -udpRecvFrom :: N.Socket -> Int -> IO (Maybe B.ByteString) +udpRecvFrom :: NS.Socket -> Int -> IO (Maybe B.ByteString) udpRecvFrom sock count = do (bs,addr) <- recvFrom sock count infoM _log $ "Received UDP message from " ++ (show addr) ++ ": " ++ (show bs)