packages feed

socket 0.8.0.1 → 0.8.1.0

raw patch · 18 files changed

+204/−98 lines, 18 filesdep +faildep +semigroupsdep ~base

Dependencies added: fail, semigroups

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,3 +1,11 @@+0.8.1.0 Lars Petersen <info@lars-petersen.net> 2018-08-13++ * Issue 51: Add a `getAddress` operation for getting the local socket address.+ * Marked `System.Socket.Type.Stream.receiveAll` as deprecated.+   This is a preparation for a name reuse in upcoming 0.9.0.0.+ * Removed dead code (`Message` type).+ * Added error code `ePermissionDenied`.+ 0.8.0.1 Lars Petersen <info@lars-petersen.net> 2017-02-25   * Issue 47: Fixed haddock documentation. 
CONTRIBUTORS.txt view
@@ -1,3 +1,4 @@+Olivier Nicole (issue #15) Vyacheslav Hashov (issues #37, #38, #40, #41, #42) Alexander Vershilov (fixed bug in GHC upstream) Antom @SX91 (reported and helped with #27)
README.md view
@@ -40,7 +40,7 @@ The original [network](https://hackage.haskell.org/package/network) library suffers from this, too. For example, connection attempts are non-interruptible etc. The approach taken to circumvent this in this library is to poll the-non-blocking sockets with increasing delay. This guarantees non-interruptability+non-blocking sockets with increasing delay. This guarantees interruptibility and fairness between different threads. It allows for decent throughput while also keeping CPU consumption on a moderate level if a socket has not seen events for a longer period of time (maximum of 1 second delay after 20
platform/linux/cbits/hs_socket.c view
@@ -105,3 +105,9 @@   *err = errno;   return i; }++int hs_getsockname(int fd, struct sockaddr *addr, socklen_t *addrlen, int *err) {+  int i = getsockname(fd, addr, addrlen);+  *err = errno;+  return i;+}
platform/linux/include/hs_socket.h view
@@ -33,6 +33,7 @@ #define SEAGAIN                EAGAIN #define SEWOULDBLOCK           EWOULDBLOCK #define SEBADF                 EBADF+#define SEACCES                EACCES #define SEINVAL                EINVAL #define SEINPROGRESS           EINPROGRESS #define SEPROTONOSUPPORT       EPROTONOSUPPORT
platform/linux/src/System/Socket/Internal/Platform.hsc view
@@ -11,7 +11,7 @@   ( waitRead, waitWrite, waitConnected, c_socket, c_close, c_connect,     c_accept, c_bind, c_listen, c_recv, c_recvfrom, c_send, c_sendto,     c_freeaddrinfo, c_getaddrinfo, c_getnameinfo, c_memset, c_gai_strerror,-    c_setsockopt, c_getsockopt) where+    c_setsockopt, c_getsockopt, c_getsockname) where  import Control.Monad ( when, unless ) import Control.Concurrent.MVar@@ -114,3 +114,6 @@  foreign import ccall unsafe "gai_strerror"   c_gai_strerror  :: CInt -> IO CString++foreign import ccall unsafe "hs_getsockname"+  c_getsockname  :: Fd -> Ptr a -> Ptr CInt -> Ptr CInt -> IO CInt
platform/win32/cbits/hs_socket.c view
@@ -189,3 +189,11 @@   freeaddrinfo(res);   return; };++int hs_getsockname(int fd, struct sockaddr *addr, socklen_t *addrlen, int *err) {+  int i = getsockname(fd, addr, addrlen);+  if (i < 0) {+    *err = WSAGetLastError();+  }+  return i;+}
platform/win32/include/hs_socket.h view
@@ -108,6 +108,7 @@ #define SEAGAIN                WSATRY_AGAIN #define SEWOULDBLOCK           WSAEWOULDBLOCK #define SEBADF                 WSAEBADF+#define SEACCES                WSAEACCES #define SEINVAL                WSAEINVAL #define SEINPROGRESS           WSAEINPROGRESS #define SEPROTONOSUPPORT       WSAEPROTONOSUPPORT
platform/win32/src/System/Socket/Internal/Platform.hsc view
@@ -132,3 +132,6 @@  foreign import ccall safe "hs_getnameinfo"   c_getnameinfo  :: Ptr a -> CInt -> CString -> CInt -> CString -> CInt -> CInt -> IO CInt++foreign import ccall unsafe "hs_getsockname"+  c_getsockname  :: Fd -> Ptr a -> Ptr CInt -> Ptr CInt -> IO CInt
socket.cabal view
@@ -1,5 +1,5 @@ name:                socket-version:             0.8.0.1+version:             0.8.1.0 synopsis:            An extensible socket library. description:   This library is a minimal cross-platform interface for@@ -14,8 +14,9 @@ cabal-version:       >=1.10 homepage:            https://github.com/lpeterse/haskell-socket bug-reports:         https://github.com/lpeterse/haskell-socket/issues-tested-with:         GHC==7.8.1, GHC==7.8.2, GHC==7.8.3, GHC==7.8.4,-                     GHC==7.10.1, GHC==7.10.2, GHC==7.10.3, GHC==8.0.1+tested-with:         GHC==7.8.1,GHC==7.8.2,GHC==7.8.3,GHC==7.8.4,+                     GHC==7.10.1, GHC==7.10.2, GHC==7.10.3,+                     GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 extra-source-files:  README.md                      CHANGELOG.md                      CONTRIBUTORS.txt@@ -46,6 +47,10 @@                      , System.Socket.Internal.Platform   build-depends:       base >= 4.7 && < 5                      , bytestring < 0.11+  if impl(ghc >= 8.0)+    ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+  else+    build-depends: fail == 4.9.*, semigroups == 0.18.*   hs-source-dirs:      src   build-tools:         hsc2hs   default-language:    Haskell2010
src/System/Socket.hsc view
@@ -74,6 +74,15 @@   , receive, receiveFrom   -- ** close   , close+  -- * Name Resolution+  -- ** getAddress+  , getAddress+  -- ** getAddressInfo+  , AddressInfo (..)+  , HasAddressInfo (..)+  -- ** getNameInfo+  , NameInfo (..)+  , HasNameInfo (..)   -- * Options   , SocketOption (..)   -- ** Error@@ -82,18 +91,11 @@   , ReuseAddress (..)   -- ** KeepAlive   , KeepAlive (..)-  -- * Name Resolution-  -- ** getAddressInfo-  , AddressInfo (..)-  , HasAddressInfo (..)-  -- ** getNameInfo-  , NameInfo (..)-  , HasNameInfo (..)   -- * Flags   -- ** MessageFlags   , MessageFlags (..)-  , msgEndOfRecord   , msgNoSignal+  , msgEndOfRecord   , msgOutOfBand   , msgWaitAll   -- ** AddressInfoFlags@@ -136,13 +138,13 @@ import Data.Function import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS-import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString.Internal as BS  import GHC.Conc ( closeFdWith )-
-import Foreign.Storable
-import Foreign.Marshal.Alloc
 +import Foreign.Storable+import Foreign.Marshal.Alloc+ import System.Socket.Unsafe  import System.Socket.Internal.Socket@@ -348,7 +350,7 @@ send :: Socket f t p -> BS.ByteString -> MessageFlags -> IO Int send s bs flags = do   bytesSent <- BS.unsafeUseAsCStringLen bs $ \(bufPtr,bufSize)->-    unsafeSend s bufPtr (fromIntegral bufSize) flags
+    unsafeSend s bufPtr (fromIntegral bufSize) flags   return (fromIntegral bytesSent)  -- | Like `send`, but allows to specify a destination address.@@ -376,10 +378,10 @@ --     on the socket and then waits when it got `eAgain` or `eWouldBlock` until --     the socket is signaled to be readable. receive :: Socket f t p -> Int -> MessageFlags -> IO BS.ByteString-receive s bufSize flags =
-  BS.createUptoN bufSize $ \bufPtr->
-    fromIntegral `fmap` unsafeReceive s bufPtr (fromIntegral bufSize) flags
-
+receive s bufSize flags =+  BS.createUptoN bufSize $ \bufPtr->+    fromIntegral `fmap` unsafeReceive s bufPtr (fromIntegral bufSize) flags+ -- | Like `receive`, but additionally yields the peer address. receiveFrom :: (Family f) => Socket f t p -> Int -> MessageFlags -> IO (BS.ByteString, SocketAddress f) receiveFrom = receiveFrom'@@ -388,11 +390,11 @@     receiveFrom' s bufSize flags = do       alloca $ \addrPtr-> do         alloca $ \addrSizePtr-> do-          poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SocketAddress f))
-          bs <- BS.createUptoN bufSize $ \bufPtr->
-            fromIntegral `fmap` unsafeReceiveFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr
-          addr <- peek addrPtr
-          return (bs, addr)
+          poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SocketAddress f))+          bs <- BS.createUptoN bufSize $ \bufPtr->+            fromIntegral `fmap` unsafeReceiveFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr+          addr <- peek addrPtr+          return (bs, addr)  -- | Closes a socket. --@@ -431,3 +433,25 @@       -- When we arrive here, no exception has been thrown and the descriptor has been closed.       -- We put an invalid file descriptor into the MVar.       return (-1)++-- | Get a socket's (local) address.+--+-- > > (socket :: IO (Socket Inet Stream TCP)) >>= getAddress+-- > SocketAddressInet {inetAddress = InetAddress 0.0.0.0, inetPort = InetPort 0}+--+--   - The operation throws `SocketException`s. Calling `getAddress` on a `close`d+--     socket throws `eBadFileDescriptor` even if the former file descriptor has+--     been reassigned.+--   - Behaviour of calling `getAddress` on a socket that is neither bound nor connected+--     is undefined.+getAddress :: (Family f) => Socket f t p -> IO (SocketAddress f)+getAddress = getAddress'+  where+    getAddress' :: forall f t p. (Family f) => Socket f t p -> IO (SocketAddress f)+    getAddress' (Socket mfd) = alloca $ \addrPtr -> alloca $ \addrSizePtr -> alloca $ \errPtr -> do+      poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SocketAddress f))+      withMVar mfd $ \fd -> do+        i <- c_getsockname fd addrPtr addrSizePtr errPtr+        when (i /= 0) (SocketException <$> peek errPtr >>= throwIO)+        addr <- peek addrPtr+        return addr
src/System/Socket/Family/Inet.hsc view
@@ -89,7 +89,7 @@       deriving (Eq)  newtype InetPort = InetPort Word16-      deriving (Eq, Ord, Show, Num)+      deriving (Eq, Ord, Show, Num, Real, Enum, Integral)  -- | Constructs a custom `InetAddress`. --
src/System/Socket/Family/Inet6.hsc view
@@ -94,13 +94,13 @@       deriving (Eq)  newtype Inet6Port     = Inet6Port Word16-      deriving (Eq, Ord, Show, Num)+      deriving (Eq, Ord, Show, Num, Real, Enum, Integral)  newtype Inet6FlowInfo = Inet6FlowInfo Word32-      deriving (Eq, Ord, Show, Num)+      deriving (Eq, Ord, Show, Num, Real, Enum, Integral)  newtype Inet6ScopeId  = Inet6ScopeId Word32-      deriving (Eq, Ord, Show, Num)+      deriving (Eq, Ord, Show, Num, Real, Enum, Integral)  -- | Deconstructs an `Inet6Address`. inet6AddressToTuple :: Inet6Address -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16)
src/System/Socket/Internal/AddressInfo.hsc view
@@ -45,6 +45,7 @@  import Data.Monoid import Data.Bits+import Data.Semigroup as Sem import Data.Typeable import qualified Data.ByteString as BS @@ -149,12 +150,14 @@       = AddressInfoFlags CInt       deriving (Eq, Show, Bits) -instance Data.Monoid.Monoid AddressInfoFlags where-  mempty-    = AddressInfoFlags 0-  mappend (AddressInfoFlags a) (AddressInfoFlags b)+instance Sem.Semigroup AddressInfoFlags where+  (AddressInfoFlags a) <> (AddressInfoFlags b)     = AddressInfoFlags (a .|. b) +instance Data.Monoid.Monoid AddressInfoFlags where+  mempty  = AddressInfoFlags 0+  mappend = (Sem.<>)+ -- | @AI_ADDRCONFIG@: aiAddressConfig  :: AddressInfoFlags aiAddressConfig   = AddressInfoFlags (#const AI_ADDRCONFIG)@@ -193,11 +196,13 @@       = NameInfoFlags CInt       deriving (Eq, Show, Bits) -instance Monoid NameInfoFlags where-  mempty-    = NameInfoFlags 0-  mappend (NameInfoFlags a) (NameInfoFlags b)+instance Sem.Semigroup NameInfoFlags where+  (NameInfoFlags a) <> (NameInfoFlags b)     = NameInfoFlags (a .|. b)++instance Monoid NameInfoFlags where+  mempty  = NameInfoFlags 0+  mappend = (Sem.<>)  -- | @NI_NAMEREQD@: Throw an exception if the hostname cannot be determined. niNameRequired               :: NameInfoFlags
src/System/Socket/Internal/Exception.hsc view
@@ -13,6 +13,7 @@   , eOk   , eInterrupted   , eBadFileDescriptor+  , ePermissionDenied   , eInvalid   , ePipe   , eWouldBlock@@ -71,6 +72,7 @@     | e == eOk                           = "eOk"     | e == eInterrupted                  = "eInterrupted"     | e == eBadFileDescriptor            = "eBadFileDescriptor"+    | e == ePermissionDenied             = "ePermissionDenied"     | e == eInvalid                      = "eInvalid"     | e == ePipe                         = "ePipe"     | e == eWouldBlock                   = "eWouldBlock"@@ -106,155 +108,159 @@     | otherwise                          = let SocketException n = e                                            in "SocketException " ++ show n --- | > SocketException "No error"+-- | No error. eOk                         :: SocketException eOk                          = SocketException (#const SEOK) --- | > SocketException "Interrupted system call"+-- | Interrupted system call. -- --   NOTE: This exception shall not be thrown by any public operation in this --   library, but is handled internally. eInterrupted                :: SocketException eInterrupted                 = SocketException (#const SEINTR) --- | > SocketException "Bad file descriptor"+-- | Bad file descriptor. eBadFileDescriptor          :: SocketException eBadFileDescriptor           = SocketException (#const SEBADF) --- | > SocketException "Invalid argument"+-- | Permission denied.+ePermissionDenied           :: SocketException+ePermissionDenied            = SocketException (#const SEACCES)++-- | Invalid argument. eInvalid                    :: SocketException eInvalid                     = SocketException (#const SEINVAL) --- | > SocketException "Broken pipe"+-- | Broken pipe. ePipe                       :: SocketException ePipe                        = SocketException (#const SEPIPE) --- | > SocketException "Resource temporarily unavailable"+-- | Resource temporarily unavailable. -- --   NOTE: This exception shall not be thrown by any public operation in this --   library, but is handled internally. eWouldBlock                 :: SocketException eWouldBlock                  = SocketException (#const SEWOULDBLOCK) --- | > SocketException "Resource temporarily unavailable"+-- | Resource temporarily unavailable. eAgain                      :: SocketException eAgain                       = SocketException (#const SEAGAIN) --- | > SocketException "Socket operation on non-socket"+-- | Socket operation on non-socket. -- --  NOTE: This should be ruled out by the type system. eNotSocket                  :: SocketException eNotSocket                   = SocketException (#const SENOTSOCK) --- | > SocketException "Destination address required"+-- | Destination address required. eDestinationAddressRequired :: SocketException eDestinationAddressRequired  = SocketException (#const SEDESTADDRREQ) --- | > SocketException "Message too long"+-- | Message too long. eMessageSize                :: SocketException eMessageSize                 = SocketException (#const SEMSGSIZE) --- | > SocketException "Protocol wrong type for socket"+-- | Protocol wrong type for socket.  --  NOTE: This should be ruled out by the type system. eProtocolType               :: SocketException eProtocolType                = SocketException (#const SEPROTOTYPE) --- | > SocketException "Protocol not available"+-- | Protocol not available. eNoProtocolOption           :: SocketException eNoProtocolOption            = SocketException (#const SENOPROTOOPT) --- | > SocketException "Protocol not supported"+-- | Protocol not supported. eProtocolNotSupported       :: SocketException eProtocolNotSupported        = SocketException (#const SEPROTONOSUPPORT) --- | > SocketException "Socket type not supported"+-- | Socket type not supported. eSocketTypeNotSupported     :: SocketException eSocketTypeNotSupported      = SocketException (#const SESOCKTNOSUPPORT) --- | > SocketException "Operation not supported"+-- | Operation not supported. eOperationNotSupported      :: SocketException eOperationNotSupported       = SocketException (#const SEOPNOTSUPP) --- | > SocketException "Protocol family not supported"+-- | Protocol family not supported. eProtocolFamilyNotSupported :: SocketException eProtocolFamilyNotSupported  = SocketException (#const SEPFNOSUPPORT) --- | > SocketException "Address family not supported by protocol"+-- | Address family not supported by protocol. eAddressFamilyNotSupported  :: SocketException eAddressFamilyNotSupported   = SocketException (#const SEAFNOSUPPORT) --- | > SocketException "Address already in use"+-- | Address already in use. eAddressInUse               :: SocketException eAddressInUse                = SocketException (#const SEADDRINUSE) --- | > SocketException "Cannot assign requested address"+-- | Cannot assign requested address. eAddressNotAvailable        :: SocketException eAddressNotAvailable         = SocketException (#const SEADDRNOTAVAIL) --- | > SocketException "Network is down"+-- | Network is down. eNetworkDown                :: SocketException eNetworkDown                 = SocketException (#const SENETDOWN) --- | > SocketException "Network is unreachable"+-- | Network is unreachable. eNetworkUnreachable         :: SocketException eNetworkUnreachable          = SocketException (#const SENETUNREACH) --- | > SocketException "Network dropped connection on reset"+-- | Network dropped connection on reset. eNetworkReset               :: SocketException eNetworkReset                = SocketException (#const SENETRESET) --- | > SocketException "Software caused connection abort"+-- | Software caused connection abort. eConnectionAborted          :: SocketException eConnectionAborted           = SocketException (#const SECONNABORTED) --- | > SocketException "Connection reset by peer"+-- | Connection reset by peer. eConnectionReset            :: SocketException eConnectionReset             = SocketException (#const SECONNRESET) --- | > SocketException "No buffer space available"+-- | No buffer space available. eNoBufferSpace              :: SocketException eNoBufferSpace               = SocketException (#const SENOBUFS) --- | > SocketException "Transport endpoint is already connected"+-- | Transport endpoint is already connected. eIsConnected                :: SocketException eIsConnected                 = SocketException (#const SEISCONN) --- | > SocketException "Transport endpoint is not connected"+-- | Transport endpoint is not connected. eNotConnected               :: SocketException eNotConnected                = SocketException (#const SENOTCONN) --- | > SocketException "Cannot send after transport endpoint shutdown"+-- | Cannot send after transport endpoint shutdown. eShutdown                   :: SocketException eShutdown                    = SocketException (#const SESHUTDOWN) --- | > SocketException "Too many references: cannot splice"+-- | Too many references: cannot splice. eTooManyReferences          :: SocketException eTooManyReferences           = SocketException (#const SETOOMANYREFS) --- | > SocketException "Connection timed out"+-- | Connection timed out. eTimedOut                   :: SocketException eTimedOut                    = SocketException (#const SETIMEDOUT) --- | > SocketException "Connection refused"+-- | Connection refused. eConnectionRefused          :: SocketException eConnectionRefused           = SocketException (#const SECONNREFUSED) --- | > SocketException "Host is down"+-- | Host is down. eHostDown                   :: SocketException eHostDown                    = SocketException (#const SEHOSTDOWN) --- | > SocketException "No route to host"+-- | No route to host. eHostUnreachable            :: SocketException eHostUnreachable             = SocketException (#const SEHOSTUNREACH) --- | > SocketException "Operation already in progress"+-- | Operation already in progress. -- --   NOTE: This exception shall not be thrown by any public operation in this --   library, but is handled internally. eAlready                    :: SocketException eAlready                     = SocketException (#const SEALREADY) --- | > SocketException "Operation now in progress"+-- | Operation now in progress eInProgress                 :: SocketException eInProgress                  = SocketException (#const SEINPROGRESS)
src/System/Socket/Internal/Message.hsc view
@@ -10,7 +10,6 @@ -------------------------------------------------------------------------------- module System.Socket.Internal.Message (     MessageFlags (..)-  , Message   , msgEndOfRecord   , msgNoSignal   , msgOutOfBand@@ -21,6 +20,7 @@ import Data.Monoid import Data.Maybe import Data.List (intersperse)+import Data.Semigroup as Sem  import Foreign.C.Types import Foreign.Storable@@ -38,11 +38,12 @@       = MessageFlags CInt       deriving (Eq, Bits, Storable) -data Message a t p+instance Sem.Semigroup MessageFlags where+  (<>) = (.|.)  instance Monoid MessageFlags where   mempty  = MessageFlags 0-  mappend = (.|.)+  mappend = (Sem.<>)  instance Show MessageFlags where   show msg = "mconcat [" ++ y ++ "]"@@ -56,10 +57,6 @@           ]       y = concat $ intersperse "," $ catMaybes x --- | @MSG_EOR@-msgEndOfRecord      :: MessageFlags-msgEndOfRecord       = MessageFlags (#const MSG_EOR)- -- | @MSG_NOSIGNAL@ -- --   Suppresses the generation of @PIPE@ signals when writing to a socket@@ -83,13 +80,34 @@ --     ignores them if you don't hook them explicitly. The --     non-portable socket option `SO_NOSIGPIPE` may be used disable signals --     on a per-socket basis.+--+--   __/It is safe and advised to always use this flag unless one wants to/__+--   __/explictly hook and handle the @PIPE@ signal which is not very useful in todays/__+--   __/multi-threaded environments anyway. Although GHC's RTS ignores the/__+--   __/signal by default it causes an unnecessary interruption./__ msgNoSignal         :: MessageFlags msgNoSignal          = MessageFlags (#const MSG_NOSIGNAL) +-- | @MSG_EOR@+--+--   Used by `System.Socket.Type.SequentialPacket.SequentialPacket` to mark record boundaries.+--   Consult the POSIX standard for details.+msgEndOfRecord      :: MessageFlags+msgEndOfRecord       = MessageFlags (#const MSG_EOR)+{-# WARNING msgEndOfRecord "Untested: Use at your own risk!" #-}+ -- | @MSG_OOB@+--+--   Used to send and receive out-of-band data. Consult the relevant standards+--   for details. msgOutOfBand        :: MessageFlags msgOutOfBand         = MessageFlags (#const MSG_OOB)+{-# WARNING msgOutOfBand "Untested: Use at your own risk!" #-}  -- | @MSG_WAITALL@+--+--   A `System.Socket.receive` call shall not return unless the requested number of+--   bytes becomes available. msgWaitAll          :: MessageFlags msgWaitAll           = MessageFlags (#const MSG_WAITALL)+{-# WARNING msgWaitAll "Untested: Use at your own risk!" #-}
src/System/Socket/Type/Stream.hsc view
@@ -132,8 +132,8 @@ --   - The `Data.Int.Int64` parameter is a soft limit on how many bytes to receive. --     Collection is stopped if the limit has been exceeded. The result might --     be up to one internal buffer size longer than the given limit.---     If the returned `Data.ByteString.Lazy.ByteString`s length is lower or---     eqal than the limit, the data has not been truncated and the+--     If the returned `Data.ByteString.Lazy.ByteString`s length is lower than or+--     equal to the limit, the data has not been truncated and the --     transmission is complete. receiveAll :: Socket f Stream p -> Int64 -> MessageFlags -> IO LBS.ByteString receiveAll sock maxLen flags = collect 0 Data.Monoid.mempty@@ -150,3 +150,5 @@                  $! (accum `Data.Monoid.mappend` BB.byteString bs)     build accum = do       return (BB.toLazyByteString accum)++{-# DEPRECATED receiveAll "Semantics will change in the next major release. Don't use it anymore!" #-}
test/test.hs view
@@ -1,28 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import           Control.Concurrent          (threadDelay)-import           Control.Concurrent.Async    (async, cancel, concurrently, poll,-                                              race, wait)-import           Control.Exception           (bracket, catch, throwIO, try)-import           Control.Monad               (unless, void, when)-import qualified Data.ByteString.Builder     as BB-import qualified Data.ByteString.Lazy        as LBS-import qualified Data.ByteString             as BS-import           Data.Int                    (Int64)-import           Data.Maybe                  (isJust)-import           Data.Monoid                 (mempty, mappend)-import           Prelude                     hiding (head)+import           Control.Concurrent             (threadDelay)+import           Control.Concurrent.Async       (async, cancel, concurrently,+                                                 poll, race, wait)+import           Control.Exception              (bracket, catch, throwIO, try)+import           Control.Monad                  (unless, void, when)+import qualified Data.ByteString                as BS+import qualified Data.ByteString.Builder        as BB+import qualified Data.ByteString.Lazy           as LBS+import           Data.Int                       (Int64)+import           Data.Maybe                     (isJust)+import           Data.Monoid                    (mappend, mempty)+import           Prelude                        hiding (head) import           System.Socket import           System.Socket.Family.Inet import           System.Socket.Family.Inet6+import           System.Socket.Protocol.Default import           System.Socket.Protocol.TCP import           System.Socket.Protocol.UDP import           System.Socket.Type.Datagram import           System.Socket.Type.Stream import           Test.Tasty import           Test.Tasty.HUnit-import           Test.Tasty.QuickCheck       as QC+import           Test.Tasty.QuickCheck          as QC  main :: IO () main  = defaultMain $ testGroup "socket"@@ -33,6 +34,7 @@     , group03     , group07     , group80+    , group98     , group99     ]   , testGroup "System.Socket.Inet" [@@ -49,7 +51,7 @@  group00 :: TestTree group00 = testGroup "accept"-  [ testGroup "Inet/Strem/TCP"+  [ testGroup "Inet/Stream/TCP"       [ testCase "cancel operation" $           -- | This is to test interruptability of (blocking) calls like           --   accept. The implementation may either run the call "safe"@@ -430,6 +432,19 @@     ]   ] +group98 :: TestTree+group98  = testGroup "getAddress" [++    testCase "getAddress after bind" $ bracket+      ( socket :: IO (Socket Inet Stream Default) ) close+      ( \s -> do+          let addr = SocketAddressInet (inetAddressFromTuple (127,0,0,1)) 8080+          bind s addr+          addr' <- getAddress s+          assertEqual "" addr' addr+      )+  ]+ group99 :: TestTree group99  = testGroup "getAddrInfo" [ @@ -448,7 +463,7 @@   , testCase "getAddrInfo \"\" \"\"" $       void (getAddressInfo Nothing Nothing mempty :: IO [AddressInfo Inet Stream TCP]) `catch` \e-> case e of             _ | e == eaiNoName -> return ()-            _ -> assertFailure "expected eaiNoName"+            _                  -> assertFailure "expected eaiNoName"    ]