diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013-2016, Renzo Carbonara +Copyright (c) 2013-2018, Renzo Carbonara All rights reserved. diff --git a/PEOPLE b/PEOPLE --- a/PEOPLE +++ b/PEOPLE @@ -1,6 +1,7 @@ The following people have participated in creating this library, either by directly contributing code or by providing thoughtful input in -discussions about the library design. +discussions about the library design. Please note that if you want to be +part of this list you need to add yourself to it. Renzo Carbonara Gabriel Gonzalez diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,4 @@ +#! /usr/bin/env nix-shell +#! nix-shell ./shell.nix -i runghc import Distribution.Simple main = defaultMain diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +# Version 0.4.1 + +* Fix `HostAny` so that IPv6 addresses are correctly included as well. See #22. + +* Implement a very crude version of _Happy Eyeballs_ (RFC 8305). See #15. + +* Remove upper bounds from all dependencies other than `base`. + + # Version 0.4.0.5 * Bump upper bound on `transformers` dependency. diff --git a/network-simple.cabal b/network-simple.cabal --- a/network-simple.cabal +++ b/network-simple.cabal @@ -1,12 +1,12 @@ name: network-simple -version: 0.4.0.5 +version: 0.4.1 homepage: https://github.com/k0001/network-simple bug-reports: https://github.com/k0001/network-simple/issues license: BSD3 license-file: LICENSE author: Renzo Carbonara -maintainer: renzocarbonaraλgmail.com -copyright: Copyright (c) Renzo Carbonara 2013-2016 +maintainer: renλren.zone +copyright: Copyright (c) Renzo Carbonara 2013-2018 category: Network build-type: Simple cabal-version: >=1.8 @@ -33,8 +33,8 @@ hs-source-dirs: src exposed-modules: Network.Simple.TCP other-modules: Network.Simple.Internal - build-depends: base (>=4.5 && < 5) - , network (>=2.3 && <2.7) - , bytestring (>=0.9.2.1 && <0.11) - , transformers (>=0.2 && <0.6) - , exceptions (>=0.6 && <0.9) + build-depends: base (>=4.7 && < 5) + , network (>=2.3) + , bytestring (>=0.9.2.1) + , transformers (>=0.2) + , exceptions (>=0.6) diff --git a/src/Network/Simple/Internal.hs b/src/Network/Simple/Internal.hs --- a/src/Network/Simple/Internal.hs +++ b/src/Network/Simple/Internal.hs @@ -8,9 +8,17 @@ module Network.Simple.Internal ( HostPreference(..) , hpHostName + , ipv4mapped_to_ipv4 + , isIPv4addr + , isIPv6addr + , prioritize + , happyEyeballSort ) where +import Data.Bits (shiftR, (.&.)) +import qualified Data.List as List import Data.String (IsString (fromString)) +import Data.Word (byteSwap32) import qualified Network.Socket as NS -- | Preferred host to bind. @@ -41,3 +49,29 @@ hpHostName (Host s) = Just s hpHostName _ = Nothing +-- | Convert IPv4-Mapped IPv6 Addresses to IPv4. +ipv4mapped_to_ipv4:: NS.SockAddr -> NS.SockAddr +ipv4mapped_to_ipv4 (NS.SockAddrInet6 p _ (0, 0, 0xFFFF, h) _) + = NS.SockAddrInet p (NS.tupleToHostAddress + (fromIntegral (shiftR (h .&. 0xFF000000) 24), + fromIntegral (shiftR (h .&. 0x00FF0000) 16), + fromIntegral (shiftR (h .&. 0x0000FF00) 8), + fromIntegral (h .&. 0x000000FF))) +ipv4mapped_to_ipv4 sa = sa + +-- | Given a list of 'NS.AddrInfo's, reorder it so that ipv6 and ipv4 addresses, +-- when available, are intercalated, with a ipv6 address first. +happyEyeballSort :: [NS.AddrInfo] -> [NS.AddrInfo] +happyEyeballSort l = + concat (List.transpose ((\(a,b) -> [a,b]) (List.partition isIPv6addr l))) + +isIPv4addr :: NS.AddrInfo -> Bool +isIPv4addr x = NS.addrFamily x == NS.AF_INET + +isIPv6addr :: NS.AddrInfo -> Bool +isIPv6addr x = NS.addrFamily x == NS.AF_INET6 + +-- | Move the elements that match the predicate closer to the head of the list. +-- Sorting is stable. +prioritize :: (a -> Bool) -> [a] -> [a] +prioritize p = uncurry (++) . List.partition p diff --git a/src/Network/Simple/TCP.hs b/src/Network/Simple/TCP.hs --- a/src/Network/Simple/TCP.hs +++ b/src/Network/Simple/TCP.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | This module exports functions that abstract simple TCP 'NS.Socket' -- usage patterns. @@ -56,19 +58,23 @@ , NS.SockAddr ) where -import Control.Concurrent (ThreadId, forkIO) +import Control.Concurrent (ThreadId, forkIO, forkFinally) import qualified Control.Exception as E import qualified Control.Monad.Catch as C import Control.Monad import Control.Monad.IO.Class (MonadIO(liftIO)) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL -import Data.List (partition) +import Data.List (transpose, partition) import qualified Network.Socket as NS -import Network.Simple.Internal import qualified Network.Socket.ByteString as NSB import qualified Network.Socket.ByteString.Lazy as NSBL +import System.Timeout (timeout) +import Network.Simple.Internal + (HostPreference(..), hpHostName, isIPv4addr, isIPv6addr, ipv4mapped_to_ipv4, + prioritize, happyEyeballSort) + -------------------------------------------------------------------------------- -- $tcp-101 -- @@ -194,7 +200,7 @@ listen hp port = C.bracket listen' (silentCloseSock . fst) where listen' = do x@(bsock,_) <- bindSock hp port - liftIO . NS.listen bsock $ max 2048 NS.maxListenQueue + liftIO $ NS.listen bsock $ max 2048 NS.maxListenQueue return x -------------------------------------------------------------------------------- @@ -211,7 +217,8 @@ -- and remote end address. -> m r accept lsock k = do - conn@(csock,_) <- liftIO (NS.accept lsock) + (csock, addr) <- liftIO (NS.accept lsock) + let conn = (csock, ipv4mapped_to_ipv4 addr) C.finally (k conn) (silentCloseSock csock) {-# INLINABLE accept #-} @@ -227,7 +234,8 @@ -- connection socket and remote end address. -> m ThreadId acceptFork lsock k = liftIO $ do - conn@(csock,_) <- NS.accept lsock + (csock,addr) <- NS.accept lsock + let conn = (csock, ipv4mapped_to_ipv4 addr) forkFinally (k conn) (\ea -> do silentCloseSock csock either E.throwIO return ea) @@ -244,18 +252,33 @@ -- Prefer to use 'connect' if you will be using the socket within a limited -- scope and would like it to be closed immediately after its usage or in case -- of exceptions. -connectSock :: MonadIO m - => NS.HostName -> NS.ServiceName -> m (NS.Socket, NS.SockAddr) +connectSock + :: MonadIO m => NS.HostName -> NS.ServiceName -> m (NS.Socket, NS.SockAddr) connectSock host port = liftIO $ do - (addr:_) <- NS.getAddrInfo (Just hints) (Just host) (Just port) - E.bracketOnError (newSocket addr) closeSock $ \sock -> do - let sockAddr = NS.addrAddress addr - NS.connect sock sockAddr - return (sock, sockAddr) + addrs <- NS.getAddrInfo (Just hints) (Just host) (Just port) + tryAddrs (happyEyeballSort addrs) where - hints = NS.defaultHints { NS.addrFlags = [NS.AI_ADDRCONFIG] - , NS.addrSocketType = NS.Stream } + hints :: NS.AddrInfo + hints = NS.defaultHints + { NS.addrFlags = [NS.AI_ADDRCONFIG] + , NS.addrSocketType = NS.Stream } + tryAddrs :: [NS.AddrInfo] -> IO (NS.Socket, NS.SockAddr) + tryAddrs = \case + [] -> fail "connectSock: No addresses available" + [x] -> useAddr x + (x:xs) -> E.catch (useAddr x) (\(_ :: IOError) -> tryAddrs xs) + useAddr :: NS.AddrInfo -> IO (NS.Socket, NS.SockAddr) + useAddr addr = do + yx <- timeout 1000000 $ do -- 1 second + E.bracketOnError (newSocket addr) closeSock $ \sock -> do + let sockAddr = NS.addrAddress addr + NS.connect sock sockAddr + pure (sock, sockAddr) + case yx of + Nothing -> fail "connectSock: Timeout on connect" + Just x -> pure x + -- | Obtain a 'NS.Socket' bound to the given host name and TCP service port. -- -- The obtained 'NS.Socket' should be closed manually using 'closeSock' when @@ -264,41 +287,39 @@ -- Prefer to use 'listen' if you will be listening on this socket and using it -- within a limited scope, and would like it to be closed immediately after its -- usage or in case of exceptions. -bindSock :: MonadIO m - => HostPreference -> NS.ServiceName -> m (NS.Socket, NS.SockAddr) +bindSock + :: MonadIO m => HostPreference -> NS.ServiceName -> m (NS.Socket, NS.SockAddr) bindSock hp port = liftIO $ do addrs <- NS.getAddrInfo (Just hints) (hpHostName hp) (Just port) - let addrs' = case hp of - HostIPv4 -> prioritize isIPv4addr addrs - HostIPv6 -> prioritize isIPv6addr addrs - _ -> addrs - tryAddrs addrs' + tryAddrs $ case hp of + HostIPv4 -> prioritize isIPv4addr addrs + HostIPv6 -> prioritize isIPv6addr addrs + HostAny -> prioritize isIPv6addr addrs + _ -> addrs where - hints = NS.defaultHints { NS.addrFlags = [NS.AI_PASSIVE] - , NS.addrSocketType = NS.Stream } - - tryAddrs [] = error "bindSock: no addresses available" - tryAddrs [x] = useAddr x - tryAddrs (x:xs) = E.catch (useAddr x) - (\e -> let _ = e :: IOError in tryAddrs xs) - + hints :: NS.AddrInfo + hints = NS.defaultHints + { NS.addrFlags = [NS.AI_PASSIVE] + , NS.addrSocketType = NS.Stream } + tryAddrs :: [NS.AddrInfo] -> IO (NS.Socket, NS.SockAddr) + tryAddrs = \case + [] -> fail "bindSock: No addresses available" + [x] -> useAddr x + (x:xs) -> E.catch (useAddr x) (\(_ :: IOError) -> tryAddrs xs) + useAddr :: NS.AddrInfo -> IO (NS.Socket, NS.SockAddr) useAddr addr = E.bracketOnError (newSocket addr) closeSock $ \sock -> do let sockAddr = NS.addrAddress addr NS.setSocketOption sock NS.NoDelay 1 NS.setSocketOption sock NS.ReuseAddr 1 - NS.bindSocket sock sockAddr + when (isIPv6addr addr) $ do + NS.setSocketOption sock NS.IPv6Only (if hp == HostIPv6 then 1 else 0) + NS.bind sock sockAddr return (sock, sockAddr) - -- | Close the 'NS.Socket'. closeSock :: MonadIO m => NS.Socket -> m () -closeSock = liftIO . -#if MIN_VERSION_network(2,4,0) - NS.close -#else - NS.sClose -#endif -{-# INLINE closeSock #-} +closeSock s = liftIO (E.finally (NS.shutdown s NS.ShutdownBoth) (NS.close s)) +{-# INLINABLE closeSock #-} -------------------------------------------------------------------------------- -- Utils @@ -322,14 +343,13 @@ -- | Writes a lazy 'BSL.ByteString' to the socket. sendLazy :: MonadIO m => NS.Socket -> BSL.ByteString -> m () +{-# INLINABLE sendLazy #-} #if !MIN_VERSION_network(2,7,0) && defined(mingw32_HOST_OS) sendLazy sock = \lbs -> sendMany sock (BSL.toChunks lbs) -- see #13. #else sendLazy sock = \lbs -> liftIO (NSBL.sendAll sock lbs) #endif -{-# INLINABLE sendLazy #-} - -- | Writes the given list of 'BS.ByteString's to the socket. -- This is faster than sending them individually. sendMany :: MonadIO m => NS.Socket -> [BS.ByteString] -> m () @@ -337,7 +357,6 @@ {-# INLINABLE sendMany #-} -------------------------------------------------------------------------------- - -- Misc newSocket :: NS.AddrInfo -> IO NS.Socket @@ -345,29 +364,7 @@ (NS.addrSocketType addr) (NS.addrProtocol addr) -isIPv4addr, isIPv6addr :: NS.AddrInfo -> Bool -isIPv4addr x = NS.addrFamily x == NS.AF_INET -isIPv6addr x = NS.addrFamily x == NS.AF_INET6 - --- | Move the elements that match the predicate closer to the head of the list. --- Sorting is stable. -prioritize :: (a -> Bool) -> [a] -> [a] -prioritize p = uncurry (++) . partition p - - --------------------------------------------------------------------------------- - --- | 'Control.Concurrent.forkFinally' was introduced in base==4.6.0.0. We'll use --- our own version here for a while, until base==4.6.0.0 is widely establised. -forkFinally :: IO a -> (Either E.SomeException a -> IO ()) -> IO ThreadId -forkFinally action and_then = - E.mask $ \restore -> - forkIO $ E.try (restore action) >>= and_then - - -- | Like 'closeSock', except it swallows all 'IOError' exceptions. silentCloseSock :: MonadIO m => NS.Socket -> m () silentCloseSock sock = liftIO $ do - E.catch (closeSock sock) - (\e -> let _ = e :: IOError in return ()) - + E.catch (closeSock sock) (\(_ :: IOError) -> return ())