network-simple 0.4.0.5 → 0.4.1
raw patch · 7 files changed
+118/−75 lines, 7 filesdep ~basedep ~bytestringdep ~exceptionssetup-changed
Dependency ranges changed: base, bytestring, exceptions, network, transformers
Files
- LICENSE +1/−1
- PEOPLE +2/−1
- Setup.hs +2/−0
- changelog.md +9/−0
- network-simple.cabal +8/−8
- src/Network/Simple/Internal.hs +34/−0
- src/Network/Simple/TCP.hs +62/−65
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013-2016, Renzo Carbonara <renzocarbonaraλgmail.com>+Copyright (c) 2013-2018, Renzo Carbonara <renλren.zone> All rights reserved.
PEOPLE view
@@ -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
Setup.hs view
@@ -1,2 +1,4 @@+#! /usr/bin/env nix-shell+#! nix-shell ./shell.nix -i runghc import Distribution.Simple main = defaultMain
changelog.md view
@@ -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.
network-simple.cabal view
@@ -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)
src/Network/Simple/Internal.hs view
@@ -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
src/Network/Simple/TCP.hs view
@@ -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 ())