socket 0.4.0.1 → 0.5.0.0
raw patch · 34 files changed
+1123/−1056 lines, 34 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +11/−0
- CONTRIBUTORS.txt +2/−0
- README.md +2/−2
- platform/linux/src/System/Socket/Internal/Platform.hsc +5/−5
- platform/win32/src/System/Socket/Internal/Platform.hsc +5/−5
- socket.cabal +13/−12
- src/System/Socket.hsc +144/−146
- src/System/Socket/Family.hs +2/−2
- src/System/Socket/Family/INET.hsc +0/−129
- src/System/Socket/Family/INET6.hsc +0/−153
- src/System/Socket/Family/Inet.hsc +138/−0
- src/System/Socket/Family/Inet6.hsc +189/−0
- src/System/Socket/Internal/AddrInfo.hsc +0/−316
- src/System/Socket/Internal/AddressInfo.hsc +326/−0
- src/System/Socket/Internal/Exception.hsc +43/−43
- src/System/Socket/Internal/Message.hsc +67/−0
- src/System/Socket/Internal/Msg.hsc +0/−63
- src/System/Socket/Internal/Socket.hsc +41/−35
- src/System/Socket/Type/DGRAM.hsc +0/−10
- src/System/Socket/Type/Datagram.hsc +10/−0
- src/System/Socket/Type/RAW.hsc +0/−10
- src/System/Socket/Type/Raw.hsc +10/−0
- src/System/Socket/Type/SEQPACKET.hsc +0/−10
- src/System/Socket/Type/STREAM.hsc +0/−10
- src/System/Socket/Type/SequentialPacket.hsc +10/−0
- src/System/Socket/Type/Stream.hsc +10/−0
- src/System/Socket/Unsafe.hsc +16/−24
- tests/AddrInfo.hs +16/−16
- tests/IPV6_V6ONLY.hs +15/−16
- tests/NonBlockingIO.hs +4/−4
- tests/PingPong.hs +6/−6
- tests/TCP-sendAndRecvAll.hs +5/−5
- tests/TCP.hs +17/−18
- tests/UDP.hs +16/−16
CHANGELOG.md view
@@ -1,3 +1,14 @@+0.5.0.0 Lars Petersen <info@lars-petersen.net> 2015-06-19++ * Introduced newtypes `Port`, `FlowInfo` and `ScopeId` in Inet6 family.+ * Renamed nearly everything in response to very constructive criticism+ by Bryan O'Sullivan. This is a breaking change (sorry about that).+ I felt this was the last chance to get this straight before the library+ gets widely adopted.+ Additional kudos to @ignorantone and @whatsthepoint.+ * Issue #7: Typo in documentation of inaddrNONE and inaddrBROADCAST.+ Kudos to Michael Fox.+ 0.4.0.1 Lars Petersen <info@lars-petersen.net> 2015-06-17 * tar-ball did not contain relevant source files.
+ CONTRIBUTORS.txt view
@@ -0,0 +1,2 @@+Michael Fox (reported issue #7)+Bryan O'Sullivan (legitimately criticised the bizarre naming)
README.md view
@@ -25,8 +25,8 @@ - No `#ifdef` madness in the Haskell sources. The Haskell binding code uses the FFI to reference the platform's native networking functions.- If they are not Posix compliant (i.e. under Windows) an level of- indirection is introduced to write an Posix compliant equivalent in C+ If they are not Posix compliant (i.e. on Windows) an level of+ indirection is introduced to create an Posix compliant equivalent in C using whatever the plaform specific building blocks are. ### Platform Support
platform/linux/src/System/Socket/Internal/Platform.hsc view
@@ -8,7 +8,7 @@ import System.Posix.Types ( Fd(..) ) -import System.Socket.Internal.Msg+import System.Socket.Internal.Message import System.Socket.Internal.Exception socketWaitWrite' :: Fd -> Int -> IO (IO ())@@ -41,16 +41,16 @@ c_listen :: Fd -> CInt -> IO CInt foreign import ccall unsafe "send"- c_send :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CSSize+ c_send :: Fd -> Ptr a -> CSize -> MessageFlags -> IO CSSize foreign import ccall unsafe "sendto"- c_sendto :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> CInt -> IO CSSize+ c_sendto :: Fd -> Ptr a -> CSize -> MessageFlags -> Ptr b -> CInt -> IO CSSize foreign import ccall unsafe "recv"- c_recv :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CSSize+ c_recv :: Fd -> Ptr a -> CSize -> MessageFlags -> IO CSSize foreign import ccall unsafe "recvfrom"- c_recvfrom :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> Ptr CInt -> IO CSSize+ c_recvfrom :: Fd -> Ptr a -> CSize -> MessageFlags -> Ptr b -> Ptr CInt -> IO CSSize foreign import ccall unsafe "getsockopt" c_getsockopt :: Fd -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt
platform/win32/src/System/Socket/Internal/Platform.hsc view
@@ -10,7 +10,7 @@ import System.Posix.Types ( Fd(..) ) -import System.Socket.Internal.Msg+import System.Socket.Internal.Message import System.Socket.Internal.Exception socketWaitWrite' :: Fd -> Int -> IO (IO ())@@ -43,16 +43,16 @@ c_listen :: Fd -> CInt -> IO CInt foreign import ccall unsafe "hs_send"- c_send :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CSSize+ c_send :: Fd -> Ptr a -> CSize -> MessageFlags -> IO CSSize foreign import ccall unsafe "hs_sendto"- c_sendto :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> CInt -> IO CSSize+ c_sendto :: Fd -> Ptr a -> CSize -> MessageFlags -> Ptr b -> CInt -> IO CSSize foreign import ccall unsafe "hs_recv"- c_recv :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CSSize+ c_recv :: Fd -> Ptr a -> CSize -> MessageFlags -> IO CSSize foreign import ccall unsafe "hs_recvfrom"- c_recvfrom :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> Ptr CInt -> IO CSSize+ c_recvfrom :: Fd -> Ptr a -> CSize -> MessageFlags -> Ptr b -> Ptr CInt -> IO CSSize foreign import ccall unsafe "hs_getsockopt" c_getsockopt :: Fd -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt
socket.cabal view
@@ -1,5 +1,5 @@ name: socket-version: 0.4.0.1+version: 0.5.0.0 synopsis: A portable and extensible sockets library. description: /Motivation/@@ -15,12 +15,12 @@ Examples for things that have been ripped out of this library are: Unix sockets, SCTP, vectored IO (for now). .- - Absolutely no conditional export.+ - Absolutely no conditional exports. . - No `#ifdef` madness in the Haskell sources. The Haskell binding code uses the FFI to reference the platform's native networking functions.- If they are not Posix compliant (i.e. under Windows) an level of- indirection is introduced to write an Posix compliant equivalent in C+ If they are not Posix compliant (i.e. on Windows) an level of+ indirection is introduced to create an Posix compliant equivalent in C using whatever the plaform specific building blocks are. . /Platform Support/@@ -61,6 +61,7 @@ tested-with: GHC==7.10.1, GHC==7.8.3 extra-source-files: README.md CHANGELOG.md+ CONTRIBUTORS.txt platform/linux/src/System/Socket/Internal/Platform.hsc platform/linux/include/hs_socket.h platform/linux/cbits/hs_socket.c@@ -71,21 +72,21 @@ library exposed-modules: System.Socket , System.Socket.Family- , System.Socket.Family.INET- , System.Socket.Family.INET6+ , System.Socket.Family.Inet+ , System.Socket.Family.Inet6 , System.Socket.Type- , System.Socket.Type.RAW- , System.Socket.Type.DGRAM- , System.Socket.Type.STREAM- , System.Socket.Type.SEQPACKET+ , System.Socket.Type.Raw+ , System.Socket.Type.Datagram+ , System.Socket.Type.Stream+ , System.Socket.Type.SequentialPacket , System.Socket.Protocol , System.Socket.Protocol.UDP , System.Socket.Protocol.TCP , System.Socket.Unsafe other-modules: System.Socket.Internal.Socket , System.Socket.Internal.Exception- , System.Socket.Internal.Msg- , System.Socket.Internal.AddrInfo+ , System.Socket.Internal.Message+ , System.Socket.Internal.AddressInfo , System.Socket.Internal.Platform build-depends: base >= 4.7 && < 5 , bytestring < 0.11
src/System/Socket.hsc view
@@ -15,7 +15,7 @@ -- > module Main where -- > -- > import System.Socket--- > import System.Socket.Family.INET (inaddrLOOPBACK)+-- > import System.Socket.Family.Inet as Inet -- > import Data.Monoid -- > import Data.ByteString -- > import Control.Monad@@ -24,17 +24,19 @@ -- > -- > main :: IO () -- > main = do--- > s <- socket :: IO (Socket INET STREAM TCP)--- > setSockOpt s (SO_REUSEADDR True)--- > bind s (SockAddrIn 8080 inaddrLOOPBACK)+-- > s <- socket :: IO (Socket Inet Stream TCP)+-- > setSocketOption s (ReuseAddress True)+-- > bind s addr -- > listen s 5 -- > forever $ do--- > (peer,addr) <- accept s+-- > (peer,_) <- accept s -- > forkIO $ do -- > sendAll peer "Hello world!" mempty `finally` close peer+-- > where+-- > addr = SocketAddressInet Inet.loopback 8080 ----- This downloads the [Haskell website](http://www.haskell.org) and shows how to--- handle exceptions. Note the use of IPv4-mapped `INET6` addresses: This will work+-- This downloads the [Haskell website](http://www.haskell.org) and prints it to stdout.+-- Note the use of IPv4-mapped `Inet6` addresses: This will work -- even if you don't have IPv6 connectivity yet and is the preferred method -- when writing new applications. --@@ -47,17 +49,17 @@ -- > -- > main :: IO () -- > main = do--- > withConnectedSocket "www.haskell.org" "80" (aiALL `mappend` aiV4MAPPED) $ \sock-> do--- > let _ = sock :: Socket INET6 STREAM TCP+-- > withConnectedSocket "www.haskell.org" "80" (aiAll `mappend` aiV4Mapped) $ \sock-> do+-- > let _ = sock :: Socket Inet6 Stream TCP -- > sendAll sock "GET / HTTP/1.0\r\nHost: www.haskell.org\r\n\r\n" mempty--- > x <- recvAll sock (1024*1024*1024) mempty+-- > x <- receiveAll sock (1024*1024*1024) mempty -- > B.putStr x ----------------------------------------------------------------------------- module System.Socket ( -- * Name Resolution- AddrInfo (..)- -- ** getAddrInfo- , GetAddrInfo (..)+ AddressInfo (..)+ -- ** getAddressInfo+ , GetAddressInfo (..) -- ** getNameInfo , GetNameInfo (..) -- * Operations@@ -73,8 +75,8 @@ , accept -- ** send, sendTo , send, sendTo- -- ** recv, recvFrom- , recv, recvFrom+ -- ** receive, receiveFrom+ , receive, receiveFrom -- ** close , close -- * Convenience Operations@@ -82,28 +84,26 @@ , withConnectedSocket -- ** sendAll , sendAll- -- ** recvAll- , recvAll+ -- ** receiveAll+ , receiveAll -- * Sockets , Socket (..) -- ** Families , Family (..)- -- *** INET- , INET- , SockAddrIn (..)- -- *** INET6- , INET6- , SockAddrIn6 (..)+ -- *** Inet+ , Inet+ -- *** Inet6+ , Inet6 -- ** Types , Type (..)- -- *** DGRAM- , DGRAM- -- *** RAW- , RAW- -- *** SEQPACKET- , SEQPACKET- -- *** STREAM- , STREAM+ -- *** Datagram+ , Datagram+ -- *** Raw+ , Raw+ -- *** SequentialPacket+ , SequentialPacket+ -- *** Stream+ , Stream -- ** Protocols , Protocol (..) -- *** UDP@@ -113,55 +113,53 @@ -- * Exceptions -- ** SocketException , module System.Socket.Internal.Exception- -- ** AddrInfoException- , AddrInfoException (..)- , gaiStrerror- , eaiAGAIN- , eaiBADFLAGS- , eaiFAIL- , eaiFAMILY- , eaiMEMORY- , eaiNONAME- , eaiSOCKTYPE- , eaiSERVICE- , eaiSYSTEM+ -- ** AddressInfoException+ , AddressInfoException (..)+ , eaiAgain+ , eaiBadFlags+ , eaiFail+ , eaiFamily+ , eaiMemory+ , eaiNoName+ , eaiSocketType+ , eaiService+ , eaiSystem -- * Socket Options- -- ** getSockOpt- , GetSockOpt (..)- -- ** setSockOpt- , SetSockOpt (..)- , SO_ERROR (..)- , SO_REUSEADDR (..)+ -- ** getSocketOption+ , GetSocketOption (..)+ -- ** setSocketOption+ , SetSocketOption (..)+ , Error (..)+ , ReuseAddress (..) -- * Flags- -- ** MsgFlags- , MsgFlags (..)- , msgEOR- , msgNOSIGNAL- , msgOOB- , msgWAITALL- -- ** AddrInfoFlags- , AddrInfoFlags (..)- , aiADDRCONFIG- , aiALL- , aiCANONNAME- , aiNUMERICHOST- , aiNUMERICSERV- , aiPASSIVE- , aiV4MAPPED+ -- ** MessageFlags+ , MessageFlags (..)+ , msgEndOfRecord+ , msgNoSignal+ , msgOutOfBand+ , msgWaitAll+ -- ** AddressInfoFlags+ , AddressInfoFlags (..)+ , aiAddressConfig+ , aiAll+ , aiCanonicalName+ , aiNumericHost+ , aiNumericService+ , aiPassive+ , aiV4Mapped -- ** NameInfoFlags , NameInfoFlags (..)- , niNAMEREQD- , niDGRAM- , niNOFQDN- , niNUMERICHOST- , niNUMERICSERV+ , niNameRequired+ , niDatagram+ , niNoFullyQualifiedDomainName+ , niNumericHost+ , niNumericService ) where import Control.Exception import Control.Monad import Control.Applicative import Control.Concurrent-import Control.Concurrent.MVar import Data.Function import Data.Monoid@@ -182,19 +180,19 @@ import System.Socket.Internal.Socket import System.Socket.Internal.Exception-import System.Socket.Internal.Msg-import System.Socket.Internal.AddrInfo+import System.Socket.Internal.Message+import System.Socket.Internal.AddressInfo import System.Socket.Internal.Platform import System.Socket.Family-import System.Socket.Family.INET-import System.Socket.Family.INET6+import System.Socket.Family.Inet+import System.Socket.Family.Inet6 import System.Socket.Type-import System.Socket.Type.DGRAM-import System.Socket.Type.RAW-import System.Socket.Type.SEQPACKET-import System.Socket.Type.STREAM+import System.Socket.Type.Datagram+import System.Socket.Type.Raw+import System.Socket.Type.SequentialPacket+import System.Socket.Type.Stream import System.Socket.Protocol import System.Socket.Protocol.UDP@@ -210,9 +208,9 @@ -- associated type families). Examples: -- -- > -- create a IPv4-UDP-datagram socket--- > sock <- socket :: IO (Socket INET DGRAM UDP)+-- > sock <- socket :: IO (Socket Inet Datagram UDP) -- > -- create a IPv6-TCP-streaming socket--- > sock6 <- socket :: IO (Socket INET6 STREAM TCP)+-- > sock6 <- socket :: IO (Socket Inet6 Stream TCP) -- -- - This operation sets up a finalizer that automatically closes the socket -- when the garbage collection decides to collect it. This is just a@@ -223,7 +221,7 @@ -- socket descriptor on exception or regular termination of your -- computation: ----- > result <- bracket (socket :: IO (Socket INET6 STREAM TCP)) close $ \sock-> do+-- > result <- bracket (socket :: IO (Socket Inet6 Stream TCP)) close $ \sock-> do -- > somethingWith sock -- your computation here -- > return somethingelse --@@ -264,7 +262,7 @@ -- | Connects to an remote address. ----- - Calling `connect` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.+-- - Calling `connect` on a `close`d socket throws `eBadFileDescriptor` even if the former file descriptor has been reassigned. -- - This operation returns as soon as a connection has been established (as -- if the socket were blocking). The connection attempt has either failed or -- succeeded after this operation threw an exception or returned.@@ -273,19 +271,19 @@ -- failed. It should be closed then. -- - Also see [these considerations](http://cr.yp.to/docs/connect.html) on -- the problems with connecting non-blocking sockets.-connect :: Family f => Socket f t p -> SockAddr f -> IO ()+connect :: Family f => Socket f t p -> SocketAddress f -> IO () connect (Socket mfd) addr = do alloca $ \addrPtr-> do poke addrPtr addr let addrLen = fromIntegral (sizeOf addr) mwait <- withMVar mfd $ \fd-> do- when (fd < 0) (throwIO eBADF)+ when (fd < 0) (throwIO eBadFileDescriptor) -- The actual connection attempt. i <- c_connect fd addrPtr addrLen -- On non-blocking sockets we expect to get EINPROGRESS or EWOULDBLOCK. if i < 0 then do e <- c_get_last_socket_error- if e == eINPROGRESS || e == eWOULDBLOCK || e == eINTR then do+ if e == eInProgress || e == eWouldBlock || e == eInterrupted then do -- The manpage says that in this case the connection -- shall be established asynchronously and one is -- supposed to wait.@@ -312,18 +310,18 @@ i <- c_connect fd addrPtr addrLen if i < 0 then do e <- c_get_last_socket_error- if e == eISCONN then do+ if e == eIsConnected then do -- This is what we want. The connection is established. return Nothing- else if e == eALREADY then do+ else if e == eAlready then do -- The previous connection attempt is still pending. Just <$> socketWaitWrite' fd iteration else do -- The previous connection failed (results in EINPROGRESS or -- EWOULBLOCK here) or something else is wrong.- -- We throw eTIMEDOUT here as we don't know and will never+ -- We throw eTimedOut here as we don't know and will never -- know the exact reason (better suggestions appreciated).- throwIO eTIMEDOUT+ throwIO eTimedOut else do -- This means the last connection attempt succeeded immediately. -- Linux does this when connecting to the same address when the@@ -339,15 +337,15 @@ -- | Bind a socket to an address. ----- - Calling `bind` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.--- - It is assumed that `c_bind` never blocks and therefore @EINPROGRESS@, @EALREADY@ and @EINTR@ don't occur.+-- - Calling `bind` on a `close`d socket throws `eBadFileDescriptor` even if the former file descriptor has been reassigned.+-- - It is assumed that `c_bind` never blocks and therefore `eInProgress`, `eAlready` and `eInterrupted` don't occur. -- This assumption is supported by the fact that the Linux manpage doesn't mention any of these errors, -- the Posix manpage doesn't mention the last one and even MacOS' implementation will never -- fail with any of these when the socket is configured non-blocking as -- [argued here](http://stackoverflow.com/a/14485305). -- - This operation throws `SocketException`s. Consult your @man@ page for -- details and specific @errno@s.-bind :: (Family f) => Socket f t p -> SockAddr f -> IO ()+bind :: (Family f) => Socket f t p -> SocketAddress f -> IO () bind (Socket mfd) addr = do alloca $ \addrPtr-> do poke addrPtr addr@@ -360,7 +358,7 @@ -- | Starts listening and queueing connection requests on a connection-mode -- socket. ----- - Calling `listen` on a `close`d socket throws @EBADF@ even if the former+-- - Calling `listen` on a `close`d socket throws `eBadFileDescriptor` even if the former -- file descriptor has been reassigned. -- - The second parameter is called /backlog/ and sets a limit on how many -- unaccepted connections the socket implementation shall queue. A value@@ -378,7 +376,7 @@ -- | Accept a new connection. ----- - Calling `accept` on a `close`d socket throws @EBADF@ even if the former+-- - Calling `accept` on a `close`d socket throws `eBadFileDescriptor` even if the former -- file descriptor has been reassigned. -- - This operation configures the new socket non-blocking (TODO: use `accept4` if available). -- - This operation sets up a finalizer for the new socket that automatically@@ -388,17 +386,17 @@ -- manually `close` the socket when it's no longer needed. -- - This operation throws `SocketException`s. Consult your @man@ page for -- details and specific @errno@s.--- - This operation catches @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ internally+-- - This operation catches `eAgain`, `eWouldBlock` and `eInterrupted` internally -- and retries automatically.-accept :: (Family f) => Socket f t p -> IO (Socket f t p, SockAddr f)+accept :: (Family f) => Socket f t p -> IO (Socket f t p, SocketAddress f) accept s@(Socket mfd) = accept' where- accept' :: forall f t p. (Family f) => IO (Socket f t p, SockAddr f)+ accept' :: forall f t p. (Family f) => IO (Socket f t p, SocketAddress f) accept' = do -- Allocate local (!) memory for the address. alloca $ \addrPtr-> do alloca $ \addrPtrLen-> do- poke addrPtrLen (fromIntegral $ sizeOf (undefined :: SockAddr f))+ poke addrPtrLen (fromIntegral $ sizeOf (undefined :: SocketAddress f)) ( fix $ \again iteration-> do -- We mask asynchronous exceptions during this critical section. ews <- withMVarMasked mfd $ \fd-> do@@ -406,10 +404,10 @@ ft <- c_accept fd addrPtr addrPtrLen if ft < 0 then do e <- c_get_last_socket_error- if e == eWOULDBLOCK || e == eAGAIN+ if e == eWouldBlock || e == eAgain then do socketWaitRead' fd iteration >>= return . Left- else if e == eINTR+ else if e == eInterrupted -- On EINTR it is good practice to just retry. then retry else throwIO e@@ -420,7 +418,7 @@ c_get_last_socket_error >>= throwIO else do -- This peek operation might be a little expensive, but I don't see an alternative.- addr <- peek addrPtr :: IO (SockAddr f)+ addr <- peek addrPtr :: IO (SocketAddress f) -- newMVar is guaranteed to be not interruptible. mft <- newMVar ft -- Register a finalizer on the new socket.@@ -434,26 +432,26 @@ -- | Send a message on a connected socket. ----- - Calling `send` on a `close`d socket throws @EBADF@ even if the former+-- - Calling `send` on a `close`d socket throws `eBadFileDescriptor` even if the former -- file descriptor has been reassigned.--- - The operation returns the number of bytes sent. On @DGRAM@ and--- @SEQPACKET@ sockets certain assurances on atomicity exist and @EAGAIN@ or--- @EWOULDBLOCK@ are returned until the whole message would fit+-- - The operation returns the number of bytes sent. On `Datagram` and+-- `SequentialPacket` sockets certain assurances on atomicity exist and `eAgain` or+-- `eWouldBlock` are returned until the whole message would fit -- into the send buffer. --- - The flag @MSG_NOSIGNAL@ is set to supress signals which are pointless.+-- - The flag `msgNoSignal` is set to supress signals which are pointless. -- - This operation throws `SocketException`s. Consult @man 3p send@ for -- details and specific @errno@s.--- - @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ and handled internally and won't+-- - `eAgain`, `eWouldBlock` and `eInterrupted` and handled internally and won't -- be thrown. For performance reasons the operation first tries a write--- on the socket and then waits when it got @EAGAIN@ or @EWOULDBLOCK@.-send :: Socket f t p -> BS.ByteString -> MsgFlags -> IO Int+-- on the socket and then waits when it got `eAgain` or `eWouldBlock`.+send :: Socket f t p -> BS.ByteString -> MessageFlags -> IO Int send s bs flags = do bytesSent <- BS.unsafeUseAsCStringLen bs $ \(bufPtr,bufSize)-> unsafeSend s (castPtr bufPtr) (fromIntegral bufSize) flags return (fromIntegral bytesSent) -- | Like `send`, but allows for specifying a destination address.-sendTo ::(Family f) => Socket f t p -> BS.ByteString -> MsgFlags -> SockAddr f -> IO Int+sendTo ::(Family f) => Socket f t p -> BS.ByteString -> MessageFlags -> SocketAddress f -> IO Int sendTo s bs flags addr = do bytesSent <- alloca $ \addrPtr-> do poke addrPtr addr@@ -463,38 +461,38 @@ -- | Receive a message on a connected socket. ----- - Calling `recv` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.+-- - Calling `receive` on a `close`d socket throws `eBadFileDescriptor` even if the former file descriptor has been reassigned. -- - The operation takes a buffer size in bytes a first parameter which -- limits the maximum length of the returned `Data.ByteString.ByteString`.--- - This operation throws `SocketException`s. Consult @man 3p recv@ for+-- - This operation throws `SocketException`s. Consult @man 3p receive@ for -- details and specific @errno@s.--- - @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ and handled internally and won't be thrown.+-- - `eAgain`, `eWouldBlock` and `eInterrupted` and handled internally and won't be thrown. -- For performance reasons the operation first tries a read--- on the socket and then waits when it got @EAGAIN@ or @EWOULDBLOCK@.-recv :: Socket f t p -> Int -> MsgFlags -> IO BS.ByteString-recv s bufSize flags =+-- on the socket and then waits when it got `eAgain` or `eWouldBlock`.+receive :: Socket f t p -> Int -> MessageFlags -> IO BS.ByteString+receive s bufSize flags = bracketOnError ( mallocBytes bufSize ) (\bufPtr-> free bufPtr ) (\bufPtr-> do- bytesReceived <- unsafeRecv s bufPtr (fromIntegral bufSize) flags+ bytesReceived <- unsafeReceive s bufPtr (fromIntegral bufSize) flags BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived) ) --- | Like `recv`, but additionally yields the peer address.-recvFrom :: (Family f) => Socket f t p -> Int -> MsgFlags -> IO (BS.ByteString, SockAddr f)-recvFrom = recvFrom'+-- | Like `receive`, but additionally yields the peer address.+receiveFrom :: (Family f) => Socket f t p -> Int -> MessageFlags -> IO (BS.ByteString, SocketAddress f)+receiveFrom = receiveFrom' where- recvFrom' :: forall f t p. (Family f) => Socket f t p -> Int -> MsgFlags -> IO (BS.ByteString, SockAddr f)- recvFrom' s bufSize flags = do+ receiveFrom' :: forall f t p. (Family f) => Socket f t p -> Int -> MessageFlags -> IO (BS.ByteString, SocketAddress f)+ receiveFrom' s bufSize flags = do alloca $ \addrPtr-> do alloca $ \addrSizePtr-> do- poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SockAddr f))+ poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SocketAddress f)) bracketOnError ( mallocBytes bufSize ) (\bufPtr-> free bufPtr ) (\bufPtr-> do- bytesReceived <- unsafeRecvFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr+ bytesReceived <- unsafeReceiveFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr addr <- peek addrPtr bs <- BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived) return (bs, addr)@@ -507,12 +505,12 @@ -- - This operation does not block. -- - This operation wakes up all threads that are currently blocking on this -- socket. All other threads are guaranteed not to block on operations on this socket in the future.--- Threads that perform operations other than `close` on this socket will fail with @EBADF@+-- Threads that perform operations other than `close` on this socket will fail with `eBadFileDescriptor` -- after the socket has been closed (`close` replaces the -- `System.Posix.Types.Fd` in the `Control.Concurrent.MVar.MVar` with @-1@ -- to reliably avoid use-after-free situations). -- - This operation potentially throws `SocketException`s (only @EIO@ is--- documented). @EINTR@ is catched internally and retried automatically, so won't be thrown.+-- documented). `eInterrupted` is catched internally and retried automatically, so won't be thrown. close :: Socket f t p -> IO () close (Socket mfd) = do modifyMVarMasked_ mfd $ \fd-> do@@ -531,7 +529,7 @@ i <- c_close fd if i < 0 then do e <- c_get_last_socket_error- if e == eINTR + if e == eInterrupted then retry else throwIO e else return ()@@ -546,7 +544,7 @@ -- | Like `send`, but operates on lazy `Data.ByteString.Lazy.ByteString`s and -- continues until all data has been sent or an exception occured.-sendAll ::Socket f STREAM p -> LBS.ByteString -> MsgFlags -> IO ()+sendAll ::Socket f Stream p -> LBS.ByteString -> MessageFlags -> IO () sendAll s lbs flags = LBS.foldlChunks (\x bs-> x >> sendAll' bs@@ -556,25 +554,25 @@ sent <- send s bs flags when (sent < BS.length bs) $ sendAll' (BS.drop sent bs) --- | Like `recv`, but operates on lazy `Data.ByteString.Lazy.ByteString`s and+-- | Like `receive`, but operates on lazy `Data.ByteString.Lazy.ByteString`s and -- continues until either an empty part has been received (peer closed -- the connection) or given buffer limit has been exceeded or an -- exception occured. ----- - The `Int` parameter is a soft limit on how many bytes to receive.+-- - 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 -- transmission is complete.-recvAll :: Socket f STREAM p -> Int64 -> MsgFlags -> IO LBS.ByteString-recvAll sock maxLen flags = collect 0 mempty+receiveAll :: Socket f Stream p -> Int64 -> MessageFlags -> IO LBS.ByteString+receiveAll sock maxLen flags = collect 0 mempty where collect len accum | len > maxLen = do build accum | otherwise = do- bs <- recv sock BB.smallChunkSize flags+ bs <- receive sock BB.smallChunkSize flags if BS.null bs then do build accum else do@@ -585,43 +583,43 @@ -- | Looks up a name and executes an supplied action with a connected socket. ----- - The addresses returned by `getAddrInfo` are tried in sequence until a+-- - The addresses returned by `getAddressInfo` are tried in sequence until a -- connection has been established or all have been tried. -- - If `connect` fails on all addresses the exception that occured on the -- last connection attempt is thrown. -- - The supplied action is executed at most once with the first established -- connection.--- - If the address family is `INET6`, `IPV6_V6ONLY` is set to `False` which+-- - If the address family is `Inet6`, `V6Only` is set to `False` which -- means the other end may be both IPv4 or IPv6. -- - All sockets created by this operation get closed automatically.--- - This operation throws `AddrInfoException`s, `SocketException`s and all+-- - This operation throws `AddressInfoException`s, `SocketException`s and all -- exceptions that that the supplied action might throw. ----- > withConnectedSocket "wwww.haskell.org" "80" (aiALL `mappend` aiV4MAPPED) $ \sock-> do--- > let _ = sock :: Socket INET6 STREAM TCP+-- > withConnectedSocket "wwww.haskell.org" "80" (aiAll `mappend` aiV4Mapped) $ \sock-> do+-- > let _ = sock :: Socket Inet6 Stream TCP -- > doSomethingWithSocket sock withConnectedSocket :: forall f t p a.- ( GetAddrInfo f, Type t, Protocol p)+ ( GetAddressInfo f, Type t, Protocol p) => BS.ByteString -> BS.ByteString- -> AddrInfoFlags+ -> AddressInfoFlags -> (Socket f t p -> IO a) -> IO a withConnectedSocket host serv flags action = do- addrs <- getAddrInfo (Just host) (Just serv) flags :: IO [AddrInfo f t p]+ addrs <- getAddressInfo (Just host) (Just serv) flags :: IO [AddressInfo f t p] tryAddrs addrs where- tryAddrs :: [AddrInfo f t p] -> IO a+ tryAddrs :: [AddressInfo f t p] -> IO a tryAddrs [] = do -- This should not happen.- throwIO eaiNONAME+ throwIO eaiNoName tryAddrs (addr:addrs) = do eith <- bracket ( socket ) ( close ) ( \sock-> do configureSocketSpecific sock- connected <- try (connect sock $ addrAddress addr)+ connected <- try (connect sock $ socketAddress addr) case connected of Left e -> return (Left (e :: SocketException)) Right _ -> Right <$> action sock@@ -636,5 +634,5 @@ return a configureSocketSpecific sock = do- when (familyNumber (undefined :: f) == familyNumber (undefined :: INET6)) $ do- setSockOpt sock (IPV6_V6ONLY False)+ when (familyNumber (undefined :: f) == familyNumber (undefined :: Inet6)) $ do+ setSocketOption sock (V6Only False)
src/System/Socket/Family.hs view
@@ -6,6 +6,6 @@ import Foreign.C.Types import Foreign.Storable -class (Storable (SockAddr f)) => Family f where- type SockAddr f+class (Storable (SocketAddress f)) => Family f where+ type SocketAddress f familyNumber :: f -> CInt
− src/System/Socket/Family/INET.hsc
@@ -1,129 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module System.Socket.Family.INET- ( INET- , AddrIn ()- , SockAddrIn (..)- , inaddrANY- , inaddrBROADCAST- , inaddrNONE- , inaddrLOOPBACK- , inaddrUNSPEC_GROUP- , inaddrALLHOSTS_GROUP- , inaddrALLRTS_GROUP- , inaddrMAXLOCAL_GROUP- ) where--import Data.Word-import Data.List-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BS--import Control.Applicative--import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Utils--import System.Socket.Family-import System.Socket.Internal.Platform--#include "hs_socket.h"-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)--data INET--instance Family INET where- type SockAddr INET = SockAddrIn- familyNumber _ = (#const AF_INET)--data SockAddrIn- = SockAddrIn- { sinPort :: Word16- , sinAddr :: AddrIn- } deriving (Eq)---- | To avoid errors with endianess it was decided to keep this type abstract.------ Hint: Use the `Foreign.Storable.Storable` instance if you really need to access. It exposes it--- exactly as found within an IP packet (big endian if you insist--- on interpreting it as a number).------ Another hint: Use `System.Socket.getAddrInfo` for parsing and suppress--- nameserver lookups:------ > > getAddrInfo (Just "127.0.0.1") Nothing aiNUMERICHOST :: IO [AddrInfo SockAddrIn STREAM TCP]--- > [AddrInfo {addrInfoFlags = AddrInfoFlags 4, addrAddress = "127.0.0.1:0", addrCanonName = Nothing}]-newtype AddrIn- = AddrIn BS.ByteString- deriving (Eq)---- | @0.0.0.0@-inaddrANY :: AddrIn-inaddrANY = AddrIn $ BS.pack [ 0, 0, 0, 0]---- | @255.255.255.0@-inaddrBROADCAST :: AddrIn-inaddrBROADCAST = AddrIn $ BS.pack [255,255,255,255]---- | @255.255.255.0@-inaddrNONE :: AddrIn-inaddrNONE = AddrIn $ BS.pack [255,255,255,255]---- | @127.0.0.1@-inaddrLOOPBACK :: AddrIn-inaddrLOOPBACK = AddrIn $ BS.pack [127, 0, 0, 1]---- | @224.0.0.0@-inaddrUNSPEC_GROUP :: AddrIn-inaddrUNSPEC_GROUP = AddrIn $ BS.pack [224, 0, 0, 0]---- | @224.0.0.1@-inaddrALLHOSTS_GROUP :: AddrIn-inaddrALLHOSTS_GROUP = AddrIn $ BS.pack [224, 0, 0, 1]---- | @224.0.0.2@-inaddrALLRTS_GROUP :: AddrIn-inaddrALLRTS_GROUP = AddrIn $ BS.pack [224, 0, 0, 2]---- | @224.0.0.255@-inaddrMAXLOCAL_GROUP :: AddrIn-inaddrMAXLOCAL_GROUP = AddrIn $ BS.pack [224, 0, 0,255]--instance Show SockAddrIn where- show (SockAddrIn p a) =- show a ++ ":" ++ show p--instance Show AddrIn where- show (AddrIn a) =- concat $ intersperse "." $ map show $ BS.unpack a--instance Storable AddrIn where- sizeOf _ = (#size uint32_t)- alignment _ = (#alignment uint32_t)- peek ptr =- AddrIn <$> BS.packCStringLen (castPtr ptr, 4)- poke ptr (AddrIn a) =- BS.unsafeUseAsCString a $ \aPtr-> do- copyBytes ptr (castPtr aPtr) (min 4 $ BS.length a)--instance Storable SockAddrIn where- sizeOf _ = (#size struct sockaddr_in)- alignment _ = (#alignment struct sockaddr_in)- peek ptr = do- ph <- peekByteOff (sin_port ptr) 0 :: IO Word8- pl <- peekByteOff (sin_port ptr) 1 :: IO Word8- a <- peek (sin_addr ptr) :: IO AddrIn- return (SockAddrIn (fromIntegral ph * 256 + fromIntegral pl) a)- where- sin_port = (#ptr struct sockaddr_in, sin_port)- sin_addr = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)- poke ptr (SockAddrIn p a) = do- c_memset ptr 0 (#const sizeof(struct sockaddr_in))- poke (sin_family ptr) ((#const AF_INET) :: Word16)- pokeByteOff (sin_port ptr) 0 (fromIntegral $ rem (quot p 256) 256 :: Word8)- pokeByteOff (sin_port ptr) 1 (fromIntegral $ rem p 256 :: Word8)- poke (sin_addr ptr) a- where- sin_family = (#ptr struct sockaddr_in, sin_family)- sin_port = (#ptr struct sockaddr_in, sin_port)- sin_addr = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)
− src/System/Socket/Family/INET6.hsc
@@ -1,153 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module System.Socket.Family.INET6- ( INET6- -- * Addresses- , AddrIn6 ()- , SockAddrIn6 (..)- -- ** Special Address Constants- , in6addrANY- , in6addrLOOPBACK- -- * Socket Options- , IPV6_V6ONLY (..)- ) where--import Data.Word-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BS--import Control.Applicative--import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Utils--import System.Socket.Family-import System.Socket.Internal.Socket-import System.Socket.Internal.Platform--#include "hs_socket.h"-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)--data INET6--instance Family INET6 where- type SockAddr INET6 = SockAddrIn6- familyNumber _ = (#const AF_INET6)--data SockAddrIn6- = SockAddrIn6- { sin6Port :: Word16- , sin6Flowinfo :: Word32- , sin6Addr :: AddrIn6- , sin6ScopeId :: Word32- } deriving (Eq)---- | To avoid errors with endianess it was decided to keep this type abstract.------ Hint: Use the `Foreign.Storable.Storable` instance if you really need to access. It exposes it--- exactly as found within an IP packet (big endian if you insist--- on interpreting it as a number).------ Another hint: Use `System.Socket.getAddrInfo` for parsing and suppress--- nameserver lookups:------ > > getAddrInfo (Just "::1") Nothing aiNUMERICHOST :: IO [AddrInfo SockAddrIn6 STREAM TCP]--- > [AddrInfo {addrInfoFlags = AddrInfoFlags 4, addrAddress = [0000:0000:0000:0000:0000:0000:0000:0001]:0, addrCanonName = Nothing}]-newtype AddrIn6- = AddrIn6 BS.ByteString- deriving (Eq)---- | @::@-in6addrANY :: AddrIn6-in6addrANY = AddrIn6 (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0])---- | @::1@-in6addrLOOPBACK :: AddrIn6-in6addrLOOPBACK = AddrIn6 (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,1])--instance Show SockAddrIn6 where- show (SockAddrIn6 p _ addr _) =- "[" ++ show addr ++ "]:" ++ show p--instance Show AddrIn6 where- show (AddrIn6 addr) = tail $ t $ BS.unpack addr- where- t [] = []- t [x] = g x 0 []- t (x:y:xs) = g x y (t xs)- g x y s = let (a,b) = quotRem x 16- (c,d) = quotRem y 16- in ':':(h a):(h b):(h c):(h d):s- h :: Word8 -> Char- h 0 = '0'- h 1 = '1'- h 2 = '2'- h 3 = '3'- h 4 = '4'- h 5 = '5'- h 6 = '6'- h 7 = '7'- h 8 = '8'- h 9 = '9'- h 10 = 'a'- h 11 = 'b'- h 12 = 'c'- h 13 = 'd'- h 14 = 'e'- h 15 = 'f'- h _ = '_'--instance Storable AddrIn6 where- sizeOf _ = 16- alignment _ = 16- peek ptr =- AddrIn6 <$> BS.packCStringLen (castPtr ptr, 16)- poke ptr (AddrIn6 a) =- BS.unsafeUseAsCString a $ \aPtr-> do- copyBytes ptr (castPtr aPtr) (min 16 $ BS.length a)--instance Storable SockAddrIn6 where- sizeOf _ = (#size struct sockaddr_in6)- alignment _ = (#alignment struct sockaddr_in6)- peek ptr = do- f <- peek (sin6_flowinfo ptr) :: IO Word32- ph <- peekByteOff (sin6_port ptr) 0 :: IO Word8- pl <- peekByteOff (sin6_port ptr) 1 :: IO Word8- a <- peek (sin6_addr ptr) :: IO AddrIn6- s <- peek (sin6_scope_id ptr) :: IO Word32- return (SockAddrIn6 (fromIntegral ph * 256 + fromIntegral pl) f a s)- where- sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)- sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)- sin6_port = (#ptr struct sockaddr_in6, sin6_port)- sin6_addr = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)- poke ptr (SockAddrIn6 p f a s) = do- c_memset ptr 0 (#const sizeof(struct sockaddr_in6))- poke (sin6_family ptr) ((#const AF_INET6) :: Word16)- poke (sin6_flowinfo ptr) f- poke (sin6_scope_id ptr) s- pokeByteOff (sin6_port ptr) 0 (fromIntegral $ rem (quot p 256) 256 :: Word8)- pokeByteOff (sin6_port ptr) 1 (fromIntegral $ rem p 256 :: Word8)- poke (sin6_addr ptr) a- where- sin6_family = (#ptr struct sockaddr_in6, sin6_family)- sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)- sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)- sin6_port = (#ptr struct sockaddr_in6, sin6_port)- sin6_addr = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)------------------------------------------------------------------------------------ Address family specific socket options----------------------------------------------------------------------------------data IPV6_V6ONLY- = IPV6_V6ONLY Bool- deriving (Eq, Ord, Show)--instance GetSockOpt IPV6_V6ONLY where- getSockOpt s =- IPV6_V6ONLY <$> getSockOptBool s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY)--instance SetSockOpt IPV6_V6ONLY where- setSockOpt s (IPV6_V6ONLY o) =- setSockOptBool s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY) o
+ src/System/Socket/Family/Inet.hsc view
@@ -0,0 +1,138 @@+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}+module System.Socket.Family.Inet+ ( Inet+ -- * Addresses+ , SocketAddressInet (..)+ , Address ()+ , Port (..)+ -- ** Special Address Constants+ -- *** allHostsGroup+ , allHostsGroup+ -- *** any+ , System.Socket.Family.Inet.any+ -- *** broadcast+ , broadcast+ -- *** loopback+ , loopback+ -- *** maxLocalGroup+ , maxLocalGroup+ -- *** none+ , none+ -- *** unspecificGroup+ , unspecificGroup+ -- * Socket Options+ ) where++import Data.Word+import Data.List+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++import Control.Applicative++import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Utils++import System.Socket.Family+import System.Socket.Internal.Platform++#include "hs_socket.h"+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++data Inet++instance Family Inet where+ type SocketAddress Inet = SocketAddressInet+ familyNumber _ = (#const AF_INET)++data SocketAddressInet+ = SocketAddressInet+ { address :: Address+ , port :: Port+ } deriving (Eq, Show)++newtype Port+ = Port Word16+ deriving (Eq, Ord, Num)++instance Show Port where+ show (Port p) = show p++-- | To avoid errors with endianess it was decided to keep this type abstract.+--+-- Hint: Use the `Foreign.Storable.Storable` instance if you really need to access. It exposes it+-- exactly as found within an IP packet (big endian if you insist+-- on interpreting it as a number).+--+-- Another hint: Use `System.Socket.getAddressInfo` for parsing and suppress+-- nameserver lookups:+--+-- > > getAddressInfo (Just "127.0.0.1") Nothing aiNumericHost :: IO [AddressInfo Inet Stream TCP]+-- > [AddressInfo {addressInfoFlags = AddressInfoFlags 4, socketAddress = SocketAddressInet { address = 127.0.0.1, port = 0}, canonicalName = Nothing}]+newtype Address+ = Address BS.ByteString+ deriving (Eq)++-- | @0.0.0.0@+any :: Address+any = Address $ BS.pack [ 0, 0, 0, 0]++-- | @255.255.255.255@+broadcast :: Address+broadcast = Address $ BS.pack [255,255,255,255]++-- | @255.255.255.255@+none :: Address+none = Address $ BS.pack [255,255,255,255]++-- | @127.0.0.1@+loopback :: Address+loopback = Address $ BS.pack [127, 0, 0, 1]++-- | @224.0.0.0@+unspecificGroup :: Address+unspecificGroup = Address $ BS.pack [224, 0, 0, 0]++-- | @224.0.0.1@+allHostsGroup :: Address+allHostsGroup = Address $ BS.pack [224, 0, 0, 1]++-- | @224.0.0.255@+maxLocalGroup :: Address+maxLocalGroup = Address $ BS.pack [224, 0, 0,255]++instance Show Address where+ show (Address a) =+ concat $ intersperse "." $ map show $ BS.unpack a++instance Storable Address where+ sizeOf _ = (#size uint32_t)+ alignment _ = (#alignment uint32_t)+ peek ptr =+ Address <$> BS.packCStringLen (castPtr ptr, 4)+ poke ptr (Address a) =+ BS.unsafeUseAsCString a $ \aPtr-> do+ copyBytes ptr (castPtr aPtr) (min 4 $ BS.length a)++instance Storable SocketAddressInet where+ sizeOf _ = (#size struct sockaddr_in)+ alignment _ = (#alignment struct sockaddr_in)+ peek ptr = do+ ph <- peekByteOff (sin_port ptr) 0 :: IO Word8+ pl <- peekByteOff (sin_port ptr) 1 :: IO Word8+ a <- peek (sin_addr ptr) :: IO Address+ return (SocketAddressInet a (Port $ fromIntegral ph * 256 + fromIntegral pl))+ where+ sin_port = (#ptr struct sockaddr_in, sin_port)+ sin_addr = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)+ poke ptr (SocketAddressInet a (Port p)) = do+ c_memset ptr 0 (#const sizeof(struct sockaddr_in))+ poke (sin_family ptr) ((#const AF_INET) :: Word16)+ pokeByteOff (sin_port ptr) 0 (fromIntegral $ rem (quot p 256) 256 :: Word8)+ pokeByteOff (sin_port ptr) 1 (fromIntegral $ rem p 256 :: Word8)+ poke (sin_addr ptr) a+ where+ sin_family = (#ptr struct sockaddr_in, sin_family)+ sin_port = (#ptr struct sockaddr_in, sin_port)+ sin_addr = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)
+ src/System/Socket/Family/Inet6.hsc view
@@ -0,0 +1,189 @@+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}+module System.Socket.Family.Inet6+ ( Inet6+ -- * Addresses+ , SocketAddressInet6 (..)+ , Address ()+ , Port (..)+ , FlowInfo (..)+ , ScopeId (..)+ -- ** Special Address Constants+ -- *** any+ , System.Socket.Family.Inet6.any+ -- *** loopback+ , loopback+ -- * Socket Options+ -- ** V6Only+ , V6Only (..)+ ) where++import Data.Bits+import Data.Monoid+import Data.Word+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++import Control.Applicative++import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Utils++import System.Socket.Family+import System.Socket.Internal.Socket+import System.Socket.Internal.Platform++#include "hs_socket.h"+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++data Inet6++instance Family Inet6 where+ type SocketAddress Inet6 = SocketAddressInet6+ familyNumber _ = (#const AF_INET6)++-- | Example:+--+-- > SocketAddressInet6 loopback 8080 mempty 0+data SocketAddressInet6+ = SocketAddressInet6+ { address :: Address+ , port :: Port+ , flowInfo :: FlowInfo+ , scopeId :: ScopeId+ } deriving (Eq, Show)++newtype Port+ = Port Word16+ deriving (Eq, Ord, Num)++instance Show Port where+ show (Port p) = show p++-- | To avoid errors with endianess it was decided to keep this type abstract.+--+-- Hint: Use the `Foreign.Storable.Storable` instance if you really need to access. It exposes it+-- exactly as found within an IP packet (big endian if you insist+-- on interpreting it as a number).+--+-- Another hint: Use `System.Socket.getAddressInfo` for parsing and suppress+-- nameserver lookups:+--+-- > > getAddressInfo (Just "::1") Nothing aiNumericHost :: IO [AddressInfo SocketAddressInet6 Stream TCP]+-- > [AddressInfo {+-- > addressInfoFlags = AddressInfoFlags 4, +-- > socketAddress = SocketAddressInet6 {address = 0000:0000:0000:0000:0000:0000:0000:0001, port = 0, flowInfo = mempty, scopeId = 0},+-- > canonicalName = Nothing }]+newtype Address+ = Address BS.ByteString+ deriving (Eq)++newtype FlowInfo+ = FlowInfo Word32+ deriving (Eq, Ord, Bits)++instance Show FlowInfo where+ show (FlowInfo i) = show i++instance Monoid FlowInfo where+ mempty = FlowInfo 0+ mappend = (.|.)++newtype ScopeId+ = ScopeId Word32+ deriving (Eq, Ord, Num)++instance Show ScopeId where+ show (ScopeId i) = show i++-- | @::@+any :: Address+any = Address (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0])++-- | @::1@+loopback :: Address+loopback = Address (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,1])++instance Show Address where+ show (Address addr) = tail $ t $ BS.unpack addr+ where+ t [] = []+ t [x] = g x 0 []+ t (x:y:xs) = g x y (t xs)+ g x y s = let (a,b) = quotRem x 16+ (c,d) = quotRem y 16+ in ':':(h a):(h b):(h c):(h d):s+ h :: Word8 -> Char+ h 0 = '0'+ h 1 = '1'+ h 2 = '2'+ h 3 = '3'+ h 4 = '4'+ h 5 = '5'+ h 6 = '6'+ h 7 = '7'+ h 8 = '8'+ h 9 = '9'+ h 10 = 'a'+ h 11 = 'b'+ h 12 = 'c'+ h 13 = 'd'+ h 14 = 'e'+ h 15 = 'f'+ h _ = '_'++instance Storable Address where+ sizeOf _ = 16+ alignment _ = 16+ peek ptr =+ Address <$> BS.packCStringLen (castPtr ptr, 16)+ poke ptr (Address a) =+ BS.unsafeUseAsCString a $ \aPtr-> do+ copyBytes ptr (castPtr aPtr) (min 16 $ BS.length a)++instance Storable SocketAddressInet6 where+ sizeOf _ = (#size struct sockaddr_in6)+ alignment _ = (#alignment struct sockaddr_in6)+ peek ptr = do+ f <- peek (sin6_flowinfo ptr) :: IO Word32+ ph <- peekByteOff (sin6_port ptr) 0 :: IO Word8+ pl <- peekByteOff (sin6_port ptr) 1 :: IO Word8+ a <- peek (sin6_addr ptr) :: IO Address+ s <- peek (sin6_scope_id ptr) :: IO Word32+ return (SocketAddressInet6 a (Port $ fromIntegral ph * 256 + fromIntegral pl) (FlowInfo f) (ScopeId s))+ where+ sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)+ sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)+ sin6_port = (#ptr struct sockaddr_in6, sin6_port)+ sin6_addr = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)+ poke ptr (SocketAddressInet6 a (Port p) (FlowInfo f) (ScopeId s)) = do+ c_memset ptr 0 (#const sizeof(struct sockaddr_in6))+ poke (sin6_family ptr) ((#const AF_INET6) :: Word16)+ poke (sin6_flowinfo ptr) f+ poke (sin6_scope_id ptr) s+ pokeByteOff (sin6_port ptr) 0 (fromIntegral $ rem (quot p 256) 256 :: Word8)+ pokeByteOff (sin6_port ptr) 1 (fromIntegral $ rem p 256 :: Word8)+ poke (sin6_addr ptr) a+ where+ sin6_family = (#ptr struct sockaddr_in6, sin6_family)+ sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)+ sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)+ sin6_port = (#ptr struct sockaddr_in6, sin6_port)+ sin6_addr = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)++-------------------------------------------------------------------------------+-- Address family specific socket options+-------------------------------------------------------------------------------++-- | @IPV6_V6ONLY@+data V6Only+ = V6Only Bool+ deriving (Eq, Ord, Show)++instance GetSocketOption V6Only where+ getSocketOption s =+ V6Only <$> getSocketOptionBool s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY)++instance SetSocketOption V6Only where+ setSocketOption s (V6Only o) =+ setSocketOptionBool s (#const IPPROTO_IPV6) (#const IPV6_V6ONLY) o
− src/System/Socket/Internal/AddrInfo.hsc
@@ -1,316 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables,- StandaloneDeriving, FlexibleContexts, TypeFamilies,- GeneralizedNewtypeDeriving #-}-module System.Socket.Internal.AddrInfo (- AddrInfo (..)- , GetAddrInfo (..)- , GetNameInfo (..)- , AddrInfoException (..)- , gaiStrerror- , eaiAGAIN- , eaiBADFLAGS- , eaiFAIL- , eaiFAMILY- , eaiMEMORY- , eaiNONAME- , eaiSOCKTYPE- , eaiSERVICE- , eaiSYSTEM- , AddrInfoFlags (..)- , aiADDRCONFIG- , aiALL- , aiCANONNAME- , aiNUMERICHOST- , aiNUMERICSERV- , aiPASSIVE- , aiV4MAPPED- , NameInfoFlags (..)- , niNAMEREQD- , niDGRAM- , niNOFQDN- , niNUMERICHOST- , niNUMERICSERV- ) where--import Control.Exception-import Control.Monad--import Data.Bits-import Data.Monoid-import Data.Typeable-import qualified Data.ByteString as BS--import Foreign.Ptr-import Foreign.Storable-import Foreign.C.Types-import Foreign.C.String-import Foreign.Marshal.Alloc--import System.IO.Unsafe--import System.Socket.Family-import System.Socket.Family.INET-import System.Socket.Family.INET6-import System.Socket.Type-import System.Socket.Protocol-import System.Socket.Internal.Platform--#include "hs_socket.h"-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)------------------------------------------------------------------------------------ AddrInfo----------------------------------------------------------------------------------data AddrInfo f t p- = AddrInfo- { addrInfoFlags :: AddrInfoFlags- , addrAddress :: SockAddr f- , addrCanonName :: Maybe BS.ByteString- }--deriving instance (Eq (SockAddr f)) => Eq (AddrInfo f t p)-deriving instance (Show (SockAddr f)) => Show (AddrInfo f t p)------------------------------------------------------------------------------------ AddrInfoException------------------------------------------------------------------------------------ | Contains the error code that can be matched against. Use `gaiStrerror`--- to get a human readable explanation of the error (show`--- does this as well).-newtype AddrInfoException- = AddrInfoException CInt- deriving (Eq, Typeable)--instance Show AddrInfoException where- show e = "AddrInfoException \"" ++ gaiStrerror e ++ "\""--instance Exception AddrInfoException---- | A wrapper around @gai_strerror@.-gaiStrerror :: AddrInfoException -> String-gaiStrerror (AddrInfoException e) =- unsafePerformIO $ do- msgPtr <- c_gai_strerror e- peekCString msgPtr---- | > AddrInfoException "Temporary failure in name resolution"-eaiAGAIN :: AddrInfoException-eaiAGAIN = AddrInfoException (#const EAI_AGAIN)---- | > AddrInfoException "Bad value for ai_flags"-eaiBADFLAGS :: AddrInfoException-eaiBADFLAGS = AddrInfoException (#const EAI_BADFLAGS)---- | > AddrInfoException "Non-recoverable failure in name resolution"-eaiFAIL :: AddrInfoException-eaiFAIL = AddrInfoException (#const EAI_FAIL)---- | > AddrInfoException "ai_family not supported"-eaiFAMILY :: AddrInfoException-eaiFAMILY = AddrInfoException (#const EAI_FAMILY)---- | > AddrInfoException "Memory allocation failure"-eaiMEMORY :: AddrInfoException-eaiMEMORY = AddrInfoException (#const EAI_MEMORY)---- | > AddrInfoException "No such host is known"-eaiNONAME :: AddrInfoException-eaiNONAME = AddrInfoException (#const EAI_NONAME)---- | > AddrInfoException "Servname not supported for ai_socktype"-eaiSERVICE :: AddrInfoException-eaiSERVICE = AddrInfoException (#const EAI_SERVICE)---- | > AddrInfoException "ai_socktype not supported"-eaiSOCKTYPE :: AddrInfoException-eaiSOCKTYPE = AddrInfoException (#const EAI_SOCKTYPE)---- | > AddrInfoException "System error"-eaiSYSTEM :: AddrInfoException-eaiSYSTEM = AddrInfoException (#const EAI_SYSTEM)----- | Use the `Data.Monoid.Monoid` instance to combine several flags:------ > mconcat [aiADDRCONFIG, aiV4MAPPED]-newtype AddrInfoFlags- = AddrInfoFlags CInt- deriving (Eq, Show, Bits)--instance Monoid AddrInfoFlags where- mempty- = AddrInfoFlags 0- mappend (AddrInfoFlags a) (AddrInfoFlags b)- = AddrInfoFlags (a .|. b)--aiADDRCONFIG :: AddrInfoFlags-aiADDRCONFIG = AddrInfoFlags (#const AI_ADDRCONFIG)---- | Return both IPv4 (as mapped `SockAddrIn6`) and IPv6 addresses when--- `aiV4MAPPED` is set independent of whether IPv6 addresses exist for this--- name.-aiALL :: AddrInfoFlags-aiALL = AddrInfoFlags (#const AI_ALL)--aiCANONNAME :: AddrInfoFlags-aiCANONNAME = AddrInfoFlags (#const AI_CANONNAME)--aiNUMERICHOST :: AddrInfoFlags-aiNUMERICHOST = AddrInfoFlags (#const AI_NUMERICHOST)--aiNUMERICSERV :: AddrInfoFlags-aiNUMERICSERV = AddrInfoFlags (#const AI_NUMERICSERV)--aiPASSIVE :: AddrInfoFlags-aiPASSIVE = AddrInfoFlags (#const AI_PASSIVE)---- | Return mapped IPv4 addresses if no IPv6 addresses could be found--- or if `aiALL` flag is set.-aiV4MAPPED :: AddrInfoFlags-aiV4MAPPED = AddrInfoFlags (#const AI_V4MAPPED)---- | Use the `Data.Monoid.Monoid` instance to combine several flags:------ > mconcat [niNAMEREQD, niNOFQDN]-newtype NameInfoFlags- = NameInfoFlags CInt- deriving (Eq, Show, Bits)--instance Monoid NameInfoFlags where- mempty- = NameInfoFlags 0- mappend (NameInfoFlags a) (NameInfoFlags b)- = NameInfoFlags (a .|. b)---- | Throw an exception if the hostname cannot be determined.-niNAMEREQD :: NameInfoFlags-niNAMEREQD = NameInfoFlags (#const NI_NAMEREQD)---- | Service is datagram based (UDP) rather than stream based (TCP).-niDGRAM :: NameInfoFlags-niDGRAM = NameInfoFlags (#const NI_DGRAM)---- | Return only the hostname part of the fully qualified domain name for local hosts.-niNOFQDN :: NameInfoFlags-niNOFQDN = NameInfoFlags (#const NI_NOFQDN)---- | Return the numeric form of the host address.-niNUMERICHOST :: NameInfoFlags-niNUMERICHOST = NameInfoFlags (#const NI_NUMERICHOST)---- | Return the numeric form of the service address.-niNUMERICSERV :: NameInfoFlags-niNUMERICSERV = NameInfoFlags (#const NI_NUMERICSERV)--class (Family f) => GetAddrInfo f where- -- | Maps names to addresses (i.e. by DNS lookup).------ The operation throws `AddrInfoException`s.------ Contrary to the underlying @getaddrinfo@ operation this wrapper is--- typesafe and thus only returns records that match the address, type--- and protocol encoded in the type. This is the price we have to pay--- for typesafe sockets and extensibility.------ If you need different types of records, you need to start several--- queries. If you want to connect to both IPv4 and IPV6 addresses use--- `aiV4MAPPED` and use IPv6-sockets.------ > > getAddrInfo (Just "www.haskell.org") (Just "80") aiV4MAPPED :: IO [AddrInfo INET6 STREAM TCP]--- > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = [2400:cb00:2048:0001:0000:0000:6ca2:cc3c]:80, addrCanonName = Nothing}]--- > > getAddrInfo (Just "darcs.haskell.org") Nothing aiV4MAPPED :: IO [AddrInfo INET6 STREAM TCP]--- > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = [0000:0000:0000:0000:0000:ffff:17fd:e1ad]:0, addrCanonName = Nothing}]--- > > getAddrInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddrInfo INET6 STREAM TCP]--- > *** Exception: AddrInfoException "Name or service not known"- getAddrInfo :: (Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo f t p]--instance GetAddrInfo INET where- getAddrInfo = getAddrInfo'--instance GetAddrInfo INET6 where- getAddrInfo = getAddrInfo'--getAddrInfo' :: forall f t p. (Family f, Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo f t p]-getAddrInfo' mnode mservice (AddrInfoFlags flags) = do- alloca $ \resultPtrPtr-> do- poke resultPtrPtr nullPtr- allocaBytes (#size struct addrinfo) $ \addrInfoPtr-> do- -- properly initialize the struct- c_memset addrInfoPtr 0 (#const sizeof(struct addrinfo))- poke (ai_flags addrInfoPtr) flags- poke (ai_family addrInfoPtr) (familyNumber (undefined :: f))- poke (ai_socktype addrInfoPtr) (typeNumber (undefined :: t))- poke (ai_protocol addrInfoPtr) (protocolNumber (undefined :: p))- fnode $ \nodePtr-> do- fservice $ \servicePtr->- bracket- (c_getaddrinfo nodePtr servicePtr addrInfoPtr resultPtrPtr)- (\_-> do resultPtr <- peek resultPtrPtr- when (resultPtr /= nullPtr) (c_freeaddrinfo resultPtr)- )- (\e-> if e == 0 then do- resultPtr <- peek resultPtrPtr- peekAddrInfos resultPtr- else do- throwIO (AddrInfoException e)- )- where- ai_flags = (#ptr struct addrinfo, ai_flags) :: Ptr (AddrInfo a t p) -> Ptr CInt- ai_family = (#ptr struct addrinfo, ai_family) :: Ptr (AddrInfo a t p) -> Ptr CInt- ai_socktype = (#ptr struct addrinfo, ai_socktype) :: Ptr (AddrInfo a t p) -> Ptr CInt- ai_protocol = (#ptr struct addrinfo, ai_protocol) :: Ptr (AddrInfo a t p) -> Ptr CInt- ai_addr = (#ptr struct addrinfo, ai_addr) :: Ptr (AddrInfo a t p) -> Ptr (Ptr a)- ai_canonname = (#ptr struct addrinfo, ai_canonname) :: Ptr (AddrInfo a t p) -> Ptr CString- ai_next = (#ptr struct addrinfo, ai_next) :: Ptr (AddrInfo a t p) -> Ptr (Ptr (AddrInfo a t p))- fnode = case mnode of- Just node -> BS.useAsCString node- Nothing -> \f-> f nullPtr- fservice = case mservice of- Just service -> BS.useAsCString service- Nothing -> \f-> f nullPtr- peekAddrInfos ptr = - if ptr == nullPtr- then return []- else do- flag <- peek (ai_flags ptr)- addr <- peek (ai_addr ptr) >>= peek- cname <- do cnPtr <- peek (ai_canonname ptr)- if cnPtr == nullPtr- then return Nothing- else BS.packCString cnPtr >>= return . Just- as <- peek (ai_next ptr) >>= peekAddrInfos- return ((AddrInfo (AddrInfoFlags flag) addr cname):as)---- | Maps addresss to readable host- and service names.------ The operation throws `AddrInfoException`s.------ > > getNameInfo (SockAddrIn 80 inaddrLOOPBACK) mempty--- > ("localhost.localdomain","http")-class (Family f) => GetNameInfo f where- getNameInfo :: SockAddr f -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)--instance GetNameInfo INET where- getNameInfo = getNameInfo'--instance GetNameInfo INET6 where- getNameInfo = getNameInfo'--getNameInfo' :: Storable a => a -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)-getNameInfo' addr (NameInfoFlags flags) =- alloca $ \addrPtr->- allocaBytes (#const NI_MAXHOST) $ \hostPtr->- allocaBytes (#const NI_MAXSERV) $ \servPtr-> do- poke addrPtr addr- e <- c_getnameinfo addrPtr (fromIntegral $ sizeOf addr)- hostPtr (#const NI_MAXHOST)- servPtr (#const NI_MAXSERV)- flags- if e == 0 then do- host <- BS.packCString hostPtr- serv <- BS.packCString servPtr- return (host,serv)- else do- throwIO (AddrInfoException e)
+ src/System/Socket/Internal/AddressInfo.hsc view
@@ -0,0 +1,326 @@+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables,+ StandaloneDeriving, FlexibleContexts, TypeFamilies,+ GeneralizedNewtypeDeriving #-}+module System.Socket.Internal.AddressInfo (+ AddressInfo (..)+ , GetAddressInfo (..)+ , GetNameInfo (..)+ , AddressInfoException (..)+ --, gaiStrerror+ , eaiAgain+ , eaiBadFlags+ , eaiFail+ , eaiFamily+ , eaiMemory+ , eaiNoName+ , eaiSocketType+ , eaiService+ , eaiSystem+ , AddressInfoFlags (..)+ , aiAddressConfig+ , aiAll+ , aiCanonicalName+ , aiNumericHost+ , aiNumericService+ , aiPassive+ , aiV4Mapped+ , NameInfoFlags (..)+ , niNameRequired+ , niDatagram+ , niNoFullyQualifiedDomainName+ , niNumericHost+ , niNumericService+ ) where++import Control.Exception+import Control.Monad++import Data.Bits+import Data.Monoid+import Data.Typeable+import qualified Data.ByteString as BS++import Foreign.Ptr+import Foreign.Storable+import Foreign.C.Types+import Foreign.C.String+import Foreign.Marshal.Alloc++import System.IO.Unsafe++import System.Socket.Family+import System.Socket.Family.Inet+import System.Socket.Family.Inet6+import System.Socket.Type+import System.Socket.Protocol+import System.Socket.Internal.Platform++#include "hs_socket.h"+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++-------------------------------------------------------------------------------+-- AddressInfo+-------------------------------------------------------------------------------++data AddressInfo f t p+ = AddressInfo+ { addressInfoFlags :: AddressInfoFlags+ , socketAddress :: SocketAddress f+ , canonicalName :: Maybe BS.ByteString+ }++deriving instance (Eq (SocketAddress f)) => Eq (AddressInfo f t p)+deriving instance (Show (SocketAddress f)) => Show (AddressInfo f t p)++-------------------------------------------------------------------------------+-- AddressInfoException+-------------------------------------------------------------------------------++-- | Contains the error code that can be matched against. Use `show`+-- to get a human readable explanation of the error.+newtype AddressInfoException+ = AddressInfoException CInt+ deriving (Eq, Typeable)++instance Show AddressInfoException where+ show e = "AddressInfoException \"" ++ gaiStrerror e ++ "\""++instance Exception AddressInfoException++-- | A wrapper around @gai_strerror@.+gaiStrerror :: AddressInfoException -> String+gaiStrerror (AddressInfoException e) =+ unsafePerformIO $ do+ msgPtr <- c_gai_strerror e+ peekCString msgPtr++-- | > AddressInfoException "Temporary failure in name resolution"+eaiAgain :: AddressInfoException+eaiAgain = AddressInfoException (#const EAI_AGAIN)++-- | > AddressInfoException "Bad value for ai_flags"+eaiBadFlags :: AddressInfoException+eaiBadFlags = AddressInfoException (#const EAI_BADFLAGS)++-- | > AddressInfoException "Non-recoverable failure in name resolution"+eaiFail :: AddressInfoException+eaiFail = AddressInfoException (#const EAI_FAIL)++-- | > AddressInfoException "ai_family not supported"+eaiFamily :: AddressInfoException+eaiFamily = AddressInfoException (#const EAI_FAMILY)++-- | > AddressInfoException "Memory allocation failure"+eaiMemory :: AddressInfoException+eaiMemory = AddressInfoException (#const EAI_MEMORY)++-- | > AddressInfoException "No such host is known"+eaiNoName :: AddressInfoException+eaiNoName = AddressInfoException (#const EAI_NONAME)++-- | > AddressInfoException "Servname not supported for ai_socktype"+eaiService :: AddressInfoException+eaiService = AddressInfoException (#const EAI_SERVICE)++-- | > AddressInfoException "ai_socktype not supported"+eaiSocketType :: AddressInfoException+eaiSocketType = AddressInfoException (#const EAI_SOCKTYPE)++-- | > AddressInfoException "System error"+eaiSystem :: AddressInfoException+eaiSystem = AddressInfoException (#const EAI_SYSTEM)+++-- | Use the `Data.Monoid.Monoid` instance to combine several flags:+--+-- > mconcat [aiAddressConfig, aiV4Mapped]+newtype AddressInfoFlags+ = AddressInfoFlags CInt+ deriving (Eq, Show, Bits)++instance Monoid AddressInfoFlags where+ mempty+ = AddressInfoFlags 0+ mappend (AddressInfoFlags a) (AddressInfoFlags b)+ = AddressInfoFlags (a .|. b)++-- | @AI_ADDRCONFIG@:+aiAddressConfig :: AddressInfoFlags+aiAddressConfig = AddressInfoFlags (#const AI_ADDRCONFIG)++-- | @AI_ALL@: Return both IPv4 (as mapped `SocketAddressInet6`) and IPv6 addresses when+-- `aiV4Mapped` is set independent of whether IPv6 addresses exist for this+-- name.+aiAll :: AddressInfoFlags+aiAll = AddressInfoFlags (#const AI_ALL)++-- | @AI_CANONNAME@:+aiCanonicalName :: AddressInfoFlags+aiCanonicalName = AddressInfoFlags (#const AI_CANONNAME)++-- | @AI_NUMERICHOST@:+aiNumericHost :: AddressInfoFlags+aiNumericHost = AddressInfoFlags (#const AI_NUMERICHOST)++-- | @AI_NUMERICSERV@:+aiNumericService :: AddressInfoFlags+aiNumericService = AddressInfoFlags (#const AI_NUMERICSERV)++-- | @AI_PASSIVE@:+aiPassive :: AddressInfoFlags+aiPassive = AddressInfoFlags (#const AI_PASSIVE)++-- | @AI_V4MAPPED@: Return mapped IPv4 addresses if no IPv6 addresses could be found+-- or if `aiAll` flag is set.+aiV4Mapped :: AddressInfoFlags+aiV4Mapped = AddressInfoFlags (#const AI_V4MAPPED)++-- | Use the `Data.Monoid.Monoid` instance to combine several flags:+--+-- > mconcat [niNameRequired, niNoFullyQualifiedDomainName]+newtype NameInfoFlags+ = NameInfoFlags CInt+ deriving (Eq, Show, Bits)++instance Monoid NameInfoFlags where+ mempty+ = NameInfoFlags 0+ mappend (NameInfoFlags a) (NameInfoFlags b)+ = NameInfoFlags (a .|. b)++-- | @NI_NAMEREQD@: Throw an exception if the hostname cannot be determined.+niNameRequired :: NameInfoFlags+niNameRequired = NameInfoFlags (#const NI_NAMEREQD)++-- | @NI_DGRAM@: Service is datagram based (i.e. `System.Socket.Protocol.UDP.UDP`) rather than stream based (i.e. `System.Socket.Protocol.TCP.TCP`).+niDatagram :: NameInfoFlags+niDatagram = NameInfoFlags (#const NI_DGRAM)++-- | @NI_NOFQDN@: Return only the hostname part of the fully qualified domain name for local hosts.+niNoFullyQualifiedDomainName :: NameInfoFlags+niNoFullyQualifiedDomainName = NameInfoFlags (#const NI_NOFQDN)++-- | @NI_NUMERICHOST@: Return the numeric form of the host address.+niNumericHost :: NameInfoFlags+niNumericHost = NameInfoFlags (#const NI_NUMERICHOST)++-- | @NI_NUMERICSERV@: Return the numeric form of the service address.+niNumericService :: NameInfoFlags+niNumericService = NameInfoFlags (#const NI_NUMERICSERV)++class (Family f) => GetAddressInfo f where+ -- | Maps names to addresses (i.e. by DNS lookup).+--+-- The operation throws `AddressInfoException`s.+--+-- Contrary to the underlying @getaddrinfo@ operation this wrapper is+-- typesafe and thus only returns records that match the address, type+-- and protocol encoded in the type. This is the price we have to pay+-- for typesafe sockets and extensibility.+--+-- If you need different types of records, you need to start several+-- queries. If you want to connect to both IPv4 and IPV6 addresses use+-- `aiV4Mapped` and use IPv6-sockets.+--+-- > > getAddressInfo (Just "www.haskell.org") (Just "80") aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP]+-- > [AddressInfo {+-- > addressInfoFlags = AddressInfoFlags 8,+-- > socketAddress = SocketAddressInet6 {address = 2400:cb00:2048:0001:0000:0000:6ca2:cc3c, port = 80, flowInfo = mempty, scopeId = 0},+-- > canonicalName = Nothing }]+-- > > getAddressInfo (Just "darcs.haskell.org") Nothing aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP]+-- > [AddressInfo {+-- > addressInfoFlags = AddressInfoFlags 8, +-- > socketAddress = SocketAddressInet6 {address = 0000:0000:0000:0000:0000:ffff:17fd:e1ad, port = 0, flowInfo = mempty, scopeId = 0},+-- > canonicalName = Nothing }]+-- > > getAddressInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddressInfo Inet6 Stream TCP]+-- > *** Exception: AddressInfoException "Name or service not known"+ getAddressInfo :: (Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddressInfoFlags -> IO [AddressInfo f t p]++instance GetAddressInfo Inet where+ getAddressInfo = getAddressInfo'++instance GetAddressInfo Inet6 where+ getAddressInfo = getAddressInfo'++getAddressInfo' :: forall f t p. (Family f, Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddressInfoFlags -> IO [AddressInfo f t p]+getAddressInfo' mnode mservice (AddressInfoFlags flags) = do+ alloca $ \resultPtrPtr-> do+ poke resultPtrPtr nullPtr+ allocaBytes (#size struct addrinfo) $ \addrInfoPtr-> do+ -- properly initialize the struct+ c_memset addrInfoPtr 0 (#const sizeof(struct addrinfo))+ poke (ai_flags addrInfoPtr) flags+ poke (ai_family addrInfoPtr) (familyNumber (undefined :: f))+ poke (ai_socktype addrInfoPtr) (typeNumber (undefined :: t))+ poke (ai_protocol addrInfoPtr) (protocolNumber (undefined :: p))+ fnode $ \nodePtr-> do+ fservice $ \servicePtr->+ bracket+ (c_getaddrinfo nodePtr servicePtr addrInfoPtr resultPtrPtr)+ (\_-> do resultPtr <- peek resultPtrPtr+ when (resultPtr /= nullPtr) (c_freeaddrinfo resultPtr)+ )+ (\e-> if e == 0 then do+ resultPtr <- peek resultPtrPtr+ peekAddressInfos resultPtr+ else do+ throwIO (AddressInfoException e)+ )+ where+ ai_flags = (#ptr struct addrinfo, ai_flags) :: Ptr (AddressInfo a t p) -> Ptr CInt+ ai_family = (#ptr struct addrinfo, ai_family) :: Ptr (AddressInfo a t p) -> Ptr CInt+ ai_socktype = (#ptr struct addrinfo, ai_socktype) :: Ptr (AddressInfo a t p) -> Ptr CInt+ ai_protocol = (#ptr struct addrinfo, ai_protocol) :: Ptr (AddressInfo a t p) -> Ptr CInt+ ai_addr = (#ptr struct addrinfo, ai_addr) :: Ptr (AddressInfo a t p) -> Ptr (Ptr a)+ ai_canonname = (#ptr struct addrinfo, ai_canonname) :: Ptr (AddressInfo a t p) -> Ptr CString+ ai_next = (#ptr struct addrinfo, ai_next) :: Ptr (AddressInfo a t p) -> Ptr (Ptr (AddressInfo a t p))+ fnode = case mnode of+ Just node -> BS.useAsCString node+ Nothing -> \f-> f nullPtr+ fservice = case mservice of+ Just service -> BS.useAsCString service+ Nothing -> \f-> f nullPtr+ peekAddressInfos ptr = + if ptr == nullPtr+ then return []+ else do+ flag <- peek (ai_flags ptr)+ addr <- peek (ai_addr ptr) >>= peek+ cname <- do cnPtr <- peek (ai_canonname ptr)+ if cnPtr == nullPtr+ then return Nothing+ else BS.packCString cnPtr >>= return . Just+ as <- peek (ai_next ptr) >>= peekAddressInfos+ return ((AddressInfo (AddressInfoFlags flag) addr cname):as)++-- | Maps addresss to readable host- and service names.+--+-- The operation throws `AddressInfoException`s.+--+-- > > getNameInfo (SocketAddressInet loopback 80) mempty+-- > ("localhost.localdomain","http")+class (Family f) => GetNameInfo f where+ getNameInfo :: SocketAddress f -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)++instance GetNameInfo Inet where+ getNameInfo = getNameInfo'++instance GetNameInfo Inet6 where+ getNameInfo = getNameInfo'++getNameInfo' :: Storable a => a -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)+getNameInfo' addr (NameInfoFlags flags) =+ alloca $ \addrPtr->+ allocaBytes (#const NI_MAXHOST) $ \hostPtr->+ allocaBytes (#const NI_MAXSERV) $ \servPtr-> do+ poke addrPtr addr+ e <- c_getnameinfo addrPtr (fromIntegral $ sizeOf addr)+ hostPtr (#const NI_MAXHOST)+ servPtr (#const NI_MAXSERV)+ flags+ if e == 0 then do+ host <- BS.packCString hostPtr+ serv <- BS.packCString servPtr+ return (host,serv)+ else do+ throwIO (AddressInfoException e)
src/System/Socket/Internal/Exception.hsc view
@@ -15,60 +15,60 @@ instance Show SocketException where show e@(SocketException i)- | e == eOK = "eOK"- | e == eINTR = "eINTR"- | e == eAGAIN = "eAGAIN"- | e == eWOULDBLOCK = "eWOULDBLOCK"- | e == eBADF = "eBADF"- | e == eINPROGRESS = "eINPROGRESS"- | e == ePROTONOSUPPORT = "ePROTONOSUPPORT"- | e == eINVAL = "eINVAL"- | e == eCONNREFUSED = "eCONNREFUSED"- | e == eNETUNREACH = "eNETUNREACH"- | e == eNOTCONN = "eNOTCONN"- | e == eALREADY = "eALREADY"- | e == eISCONN = "eISCONN"- | e == eTIMEDOUT = "eTIMEDOUT"- | otherwise = "SocketException " ++ show i+ | e == eOk = "eOk"+ | e == eInterrupted = "eInterrupted"+ | e == eAgain = "eAgain"+ | e == eWouldBlock = "eWouldBlock"+ | e == eBadFileDescriptor = "eBadFileDescriptor"+ | e == eInProgress = "eInProgress"+ | e == eProtocolNotSupported = "eProtocolNotSupported"+ | e == eInvalid = "eInvalid"+ | e == eConnectionRefused = "eConnectionRefused"+ | e == eNetworkUnreachable = "eNetworkUnreachable"+ | e == eNotConnected = "eNotConnected"+ | e == eAlready = "eAlready"+ | e == eIsConnected = "eIsConnected"+ | e == eTimedOut = "eTimedOut"+ | otherwise = "SocketException " ++ show i -eOK :: SocketException-eOK = SocketException (#const SEOK)+eOk :: SocketException+eOk = SocketException (#const SEOK) -eINTR :: SocketException-eINTR = SocketException (#const SEINTR)+eInterrupted :: SocketException+eInterrupted = SocketException (#const SEINTR) -eAGAIN :: SocketException-eAGAIN = SocketException (#const SEAGAIN)+eAgain :: SocketException+eAgain = SocketException (#const SEAGAIN) -eWOULDBLOCK :: SocketException-eWOULDBLOCK = SocketException (#const SEWOULDBLOCK)+eWouldBlock :: SocketException+eWouldBlock = SocketException (#const SEWOULDBLOCK) -eBADF :: SocketException-eBADF = SocketException (#const SEBADF)+eBadFileDescriptor :: SocketException+eBadFileDescriptor = SocketException (#const SEBADF) -eINPROGRESS :: SocketException-eINPROGRESS = SocketException (#const SEINPROGRESS)+eInProgress :: SocketException+eInProgress = SocketException (#const SEINPROGRESS) -ePROTONOSUPPORT :: SocketException-ePROTONOSUPPORT = SocketException (#const SEPROTONOSUPPORT)+eProtocolNotSupported :: SocketException+eProtocolNotSupported = SocketException (#const SEPROTONOSUPPORT) -eINVAL :: SocketException-eINVAL = SocketException (#const SEINVAL)+eInvalid :: SocketException+eInvalid = SocketException (#const SEINVAL) -eCONNREFUSED :: SocketException-eCONNREFUSED = SocketException (#const SECONNREFUSED)+eConnectionRefused :: SocketException+eConnectionRefused = SocketException (#const SECONNREFUSED) -eNETUNREACH :: SocketException-eNETUNREACH = SocketException (#const SENETUNREACH)+eNetworkUnreachable :: SocketException+eNetworkUnreachable = SocketException (#const SENETUNREACH) -eNOTCONN :: SocketException-eNOTCONN = SocketException (#const SENOTCONN)+eNotConnected :: SocketException+eNotConnected = SocketException (#const SENOTCONN) -eALREADY :: SocketException-eALREADY = SocketException (#const SEALREADY)+eAlready :: SocketException+eAlready = SocketException (#const SEALREADY) -eISCONN :: SocketException-eISCONN = SocketException (#const SEISCONN)+eIsConnected :: SocketException+eIsConnected = SocketException (#const SEISCONN) -eTIMEDOUT :: SocketException-eTIMEDOUT = SocketException (#const SETIMEDOUT)+eTimedOut :: SocketException+eTimedOut = SocketException (#const SETIMEDOUT)
+ src/System/Socket/Internal/Message.hsc view
@@ -0,0 +1,67 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module System.Socket.Internal.Message (+ MessageFlags (..)+ , Message+ , IoVec+ , msgEndOfRecord+ , msgNoSignal+ , msgOutOfBand+ , msgWaitAll+ ) where++import Data.Bits+import Data.Monoid+import Data.Maybe+import Data.List (intersperse)++import Foreign.C.Types+import Foreign.Storable++#include "hs_socket.h"++-- | Use the `Data.Monoid.Monoid` instance to combine several flags:+--+-- > mconcat [msgNoSignal, msgWaitAll]+--+-- Use the `Data.Bits.Bits` instance to check whether a flag is set:+--+-- > if flags .&. msgEndOfRecord /= mempty then ...+newtype MessageFlags+ = MessageFlags CInt+ deriving (Eq, Bits, Storable)++data Message a t p++data IoVec++instance Monoid MessageFlags where+ mempty = MessageFlags 0+ mappend = (.|.)++instance Show MessageFlags where+ show msg = "mconcat [" ++ y ++ "]"+ where+ x = [ if msg .&. msgEndOfRecord /= mempty then Just "msgEndOfRecord" else Nothing+ , if msg .&. msgNoSignal /= mempty then Just "msgNoSignal" else Nothing+ , if msg .&. msgOutOfBand /= mempty then Just "msgOutOfBand" else Nothing+ , if msg .&. msgWaitAll /= mempty then Just "msgWaitAll" else Nothing+ , let (MessageFlags i) = msg `xor` (mconcat [msgEndOfRecord,msgNoSignal,msgOutOfBand,msgWaitAll] .&. msg)+ in if i /= 0 then Just ("MessageFlags " ++ show i) else Nothing + ]+ y = concat $ intersperse "," $ catMaybes x++-- | @MSG_EOR@+msgEndOfRecord :: MessageFlags+msgEndOfRecord = MessageFlags (#const MSG_EOR)++-- | @MSG_NOSIGNAL@+msgNoSignal :: MessageFlags+msgNoSignal = MessageFlags (#const MSG_NOSIGNAL)++-- | @MSG_OOB@+msgOutOfBand :: MessageFlags+msgOutOfBand = MessageFlags (#const MSG_OOB)++-- | @MSG_WAITALL@+msgWaitAll :: MessageFlags+msgWaitAll = MessageFlags (#const MSG_WAITALL)
− src/System/Socket/Internal/Msg.hsc
@@ -1,63 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module System.Socket.Internal.Msg (- MsgFlags (..)- , Msg- , IoVec- , msgEOR- , msgNOSIGNAL- , msgOOB- , msgWAITALL- ) where--import Data.Bits-import Data.Monoid-import Data.Maybe-import Data.List (intersperse)--import Foreign.C.Types-import Foreign.Storable--#include "hs_socket.h"---- | Use the `Data.Monoid.Monoid` instance to combine several flags:------ > mconcat [msgNOSIGNAL, msgWAITALL]------ Use the `Data.Bits.Bits` instance to check whether a flag is set:------ > if flags .&. msgEOR /= mempty then ...-newtype MsgFlags- = MsgFlags CInt- deriving (Eq, Bits, Storable)--data Msg a t p--data IoVec--instance Monoid MsgFlags where- mempty = MsgFlags 0- mappend = (.|.)--instance Show MsgFlags where- show msg = "mconcat [" ++ y ++ "]"- where- x = [ if msg .&. msgEOR /= mempty then Just "msgEOR" else Nothing- , if msg .&. msgNOSIGNAL /= mempty then Just "msgNOSIGNAL" else Nothing- , if msg .&. msgOOB /= mempty then Just "msgOOB" else Nothing- , if msg .&. msgWAITALL /= mempty then Just "msgWAITALL" else Nothing- , let (MsgFlags i) = msg `xor` (mconcat [msgEOR,msgNOSIGNAL,msgOOB,msgWAITALL] .&. msg)- in if i /= 0 then Just ("MsgFlags " ++ show i) else Nothing - ]- y = concat $ intersperse "," $ catMaybes x--msgEOR :: MsgFlags-msgEOR = MsgFlags (#const MSG_EOR)--msgNOSIGNAL :: MsgFlags-msgNOSIGNAL = MsgFlags (#const MSG_NOSIGNAL)--msgOOB :: MsgFlags-msgOOB = MsgFlags (#const MSG_OOB)--msgWAITALL :: MsgFlags-msgWAITALL = MsgFlags (#const MSG_WAITALL)
src/System/Socket/Internal/Socket.hsc view
@@ -1,11 +1,15 @@ module System.Socket.Internal.Socket ( Socket (..)- , GetSockOpt (..)- , getSockOptBool- , SetSockOpt (..)- , setSockOptBool- , SO_ERROR (..)- , SO_REUSEADDR (..)+ , GetSocketOption (..)+ , getSocketOptionBool+ , getSocketOptionInt+ , getSocketOptionCInt+ , SetSocketOption (..)+ , setSocketOptionBool+ , setSocketOptionInt+ , setSocketOptionCInt+ , Error (..)+ , ReuseAddress (..) ) where import Control.Concurrent.MVar@@ -49,38 +53,40 @@ newtype Socket f t p = Socket (MVar Fd) -class GetSockOpt o where- getSockOpt :: Socket f t p -> IO o+class GetSocketOption o where+ getSocketOption :: Socket f t p -> IO o -class SetSockOpt o where- setSockOpt :: Socket f t p -> o -> IO ()+class SetSocketOption o where+ setSocketOption :: Socket f t p -> o -> IO () -data SO_ERROR- = SO_ERROR SocketException+-- | @SO_ERROR@+data Error+ = Error SocketException deriving (Eq, Ord, Show) -instance GetSockOpt SO_ERROR where- getSockOpt s =- SO_ERROR . SocketException <$> getSockOptCInt s (#const SOL_SOCKET) (#const SO_ERROR)+instance GetSocketOption Error where+ getSocketOption s =+ Error . SocketException <$> getSocketOptionCInt s (#const SOL_SOCKET) (#const SO_ERROR) -data SO_REUSEADDR- = SO_REUSEADDR Bool+-- | @SO_REUSEADDR@+data ReuseAddress+ = ReuseAddress Bool deriving (Eq, Ord, Show) -instance GetSockOpt SO_REUSEADDR where- getSockOpt s =- SO_REUSEADDR <$> getSockOptBool s (#const SOL_SOCKET) (#const SO_REUSEADDR)+instance GetSocketOption ReuseAddress where+ getSocketOption s =+ ReuseAddress <$> getSocketOptionBool s (#const SOL_SOCKET) (#const SO_REUSEADDR) -instance SetSockOpt SO_REUSEADDR where- setSockOpt s (SO_REUSEADDR o) =- setSockOptBool s (#const SOL_SOCKET) (#const SO_REUSEADDR) o+instance SetSocketOption ReuseAddress where+ setSocketOption s (ReuseAddress o) =+ setSocketOptionBool s (#const SOL_SOCKET) (#const SO_REUSEADDR) o ------------------------------------------------------------------------------- -- Unsafe helpers ------------------------------------------------------------------------------- -setSockOptBool :: Socket f t p -> CInt -> CInt -> Bool -> IO ()-setSockOptBool (Socket mfd) level name value = do+setSocketOptionBool :: Socket f t p -> CInt -> CInt -> Bool -> IO ()+setSocketOptionBool (Socket mfd) level name value = do withMVar mfd $ \fd-> alloca $ \vPtr-> do if value@@ -92,8 +98,8 @@ when (i < 0) $ do c_get_last_socket_error >>= throwIO -getSockOptBool :: Socket f t p -> CInt -> CInt -> IO Bool-getSockOptBool (Socket mfd) level name = do+getSocketOptionBool :: Socket f t p -> CInt -> CInt -> IO Bool+getSocketOptionBool (Socket mfd) level name = do withMVar mfd $ \fd-> alloca $ \vPtr-> do alloca $ \lPtr-> do@@ -106,8 +112,8 @@ v <- peek vPtr return (v == 1) -setSockOptInt :: Socket f t p -> CInt -> CInt -> Int -> IO ()-setSockOptInt (Socket mfd) level name value = do+setSocketOptionInt :: Socket f t p -> CInt -> CInt -> Int -> IO ()+setSocketOptionInt (Socket mfd) level name value = do withMVar mfd $ \fd-> alloca $ \vPtr-> do poke vPtr (fromIntegral value :: CInt)@@ -117,8 +123,8 @@ when (i < 0) $ do c_get_last_socket_error >>= throwIO -getSockOptInt :: Socket f t p -> CInt -> CInt -> IO Int-getSockOptInt (Socket mfd) level name = do+getSocketOptionInt :: Socket f t p -> CInt -> CInt -> IO Int+getSocketOptionInt (Socket mfd) level name = do withMVar mfd $ \fd-> alloca $ \vPtr-> do alloca $ \lPtr-> do@@ -131,8 +137,8 @@ v <- peek vPtr return (fromIntegral v) -setSockOptCInt :: Socket f t p -> CInt -> CInt -> CInt -> IO ()-setSockOptCInt (Socket mfd) level name value = do+setSocketOptionCInt :: Socket f t p -> CInt -> CInt -> CInt -> IO ()+setSocketOptionCInt (Socket mfd) level name value = do withMVar mfd $ \fd-> alloca $ \vPtr-> do poke vPtr value@@ -142,8 +148,8 @@ when (i < 0) $ do c_get_last_socket_error >>= throwIO -getSockOptCInt :: Socket f t p -> CInt -> CInt -> IO CInt-getSockOptCInt (Socket mfd) level name = do+getSocketOptionCInt :: Socket f t p -> CInt -> CInt -> IO CInt+getSocketOptionCInt (Socket mfd) level name = do withMVar mfd $ \fd-> alloca $ \vPtr-> do alloca $ \lPtr-> do
− src/System/Socket/Type/DGRAM.hsc
@@ -1,10 +0,0 @@-module System.Socket.Type.DGRAM where--import System.Socket.Type--#include "hs_socket.h"--data DGRAM--instance Type DGRAM where- typeNumber _ = (#const SOCK_DGRAM)
+ src/System/Socket/Type/Datagram.hsc view
@@ -0,0 +1,10 @@+module System.Socket.Type.Datagram where++import System.Socket.Type++#include "hs_socket.h"++data Datagram++instance Type Datagram where+ typeNumber _ = (#const SOCK_DGRAM)
− src/System/Socket/Type/RAW.hsc
@@ -1,10 +0,0 @@-module System.Socket.Type.RAW where--import System.Socket.Type--#include "hs_socket.h"--data RAW--instance Type RAW where- typeNumber _ = (#const SOCK_RAW)
+ src/System/Socket/Type/Raw.hsc view
@@ -0,0 +1,10 @@+module System.Socket.Type.Raw where++import System.Socket.Type++#include "hs_socket.h"++data Raw++instance Type Raw where+ typeNumber _ = (#const SOCK_RAW)
− src/System/Socket/Type/SEQPACKET.hsc
@@ -1,10 +0,0 @@-module System.Socket.Type.SEQPACKET where--import System.Socket.Type--#include "hs_socket.h"--data SEQPACKET--instance Type SEQPACKET where- typeNumber _ = (#const SOCK_SEQPACKET)
− src/System/Socket/Type/STREAM.hsc
@@ -1,10 +0,0 @@-module System.Socket.Type.STREAM where--import System.Socket.Type--#include "hs_socket.h"--data STREAM--instance Type STREAM where- typeNumber _ = (#const SOCK_STREAM)
+ src/System/Socket/Type/SequentialPacket.hsc view
@@ -0,0 +1,10 @@+module System.Socket.Type.SequentialPacket where++import System.Socket.Type++#include "hs_socket.h"++data SequentialPacket++instance Type SequentialPacket where+ typeNumber _ = (#const SOCK_SEQPACKET)
+ src/System/Socket/Type/Stream.hsc view
@@ -0,0 +1,10 @@+module System.Socket.Type.Stream where++import System.Socket.Type++#include "hs_socket.h"++data Stream++instance Type Stream where+ typeNumber _ = (#const SOCK_STREAM)
src/System/Socket/Unsafe.hsc view
@@ -5,54 +5,46 @@ , unsafeSend -- * unsafeSendTo , unsafeSendTo- -- * unsafeRecv- , unsafeRecv- -- * unsafeRecvFrom- , unsafeRecvFrom+ -- * unsafeReceive+ , unsafeReceive+ -- * unsafeReceiveFrom+ , unsafeReceiveFrom ) where import Data.Function import Data.Monoid -import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BS-import qualified Data.ByteString.Lazy as LBS- import Control.Monad import Control.Exception import Control.Concurrent.MVar import Foreign.C.Types-import Foreign.C.String import Foreign.Ptr-import Foreign.Marshal.Alloc-import Foreign.Storable import System.Socket.Internal.Socket import System.Socket.Internal.Platform import System.Socket.Internal.Exception-import System.Socket.Internal.Msg-import System.Socket.Internal.Platform+import System.Socket.Internal.Message import System.Socket.Family import System.Posix.Types (Fd) #include "hs_socket.h" -unsafeSend :: Socket a t p -> Ptr a -> CSize -> MsgFlags -> IO CInt+unsafeSend :: Socket a t p -> Ptr a -> CSize -> MessageFlags -> IO CInt unsafeSend s bufPtr bufSize flags = do- tryWaitAndRetry s socketWaitWrite' (\fd-> c_send fd bufPtr bufSize (flags `mappend` msgNOSIGNAL) )+ tryWaitAndRetry s socketWaitWrite' (\fd-> c_send fd bufPtr bufSize (flags `mappend` msgNoSignal) ) -unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MsgFlags -> Ptr (SockAddr f) -> CInt -> IO CInt+unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> CInt -> IO CInt unsafeSendTo s bufPtr bufSize flags addrPtr addrSize = do- tryWaitAndRetry s socketWaitWrite' (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNOSIGNAL) addrPtr addrSize)+ tryWaitAndRetry s socketWaitWrite' (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNoSignal) addrPtr addrSize) -unsafeRecv :: Socket a t p -> Ptr b -> CSize -> MsgFlags -> IO CInt-unsafeRecv s bufPtr bufSize flags =+unsafeReceive :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt+unsafeReceive s bufPtr bufSize flags = tryWaitAndRetry s socketWaitRead' (\fd-> c_recv fd bufPtr bufSize flags) -unsafeRecvFrom :: Socket f t p -> Ptr b -> CSize -> MsgFlags -> Ptr (SockAddr f) -> Ptr CInt -> IO CInt-unsafeRecvFrom s bufPtr bufSize flags addrPtr addrSizePtr = do+unsafeReceiveFrom :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> Ptr CInt -> IO CInt+unsafeReceiveFrom s bufPtr bufSize flags addrPtr addrSizePtr = do tryWaitAndRetry s socketWaitRead' (\fd-> c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr) tryWaitAndRetry :: Socket f t p -> (Fd -> Int-> IO (IO ())) -> (Fd -> IO CInt) -> IO CInt@@ -61,14 +53,14 @@ loop iteration = do ewr <- withMVar mfd $ \fd-> do when (fd < 0) $ do- throwIO eBADF+ throwIO eBadFileDescriptor fix $ \retry-> do i <- action fd if (i < 0) then do e <- c_get_last_socket_error- if e == eWOULDBLOCK || e == eAGAIN then do+ if e == eWouldBlock || e == eAgain then do getWaitAction fd iteration >>= return . Left- else if e == eINTR+ else if e == eInterrupted then retry else throwIO e else do
tests/AddrInfo.hs view
@@ -6,7 +6,7 @@ import Control.Monad import Control.Exception import System.Socket-import System.Socket.Family.INET+import System.Socket.Family.Inet as Inet import System.Exit main :: IO ()@@ -17,28 +17,28 @@ t0001 :: IO () t0001 = do- ais <- getAddrInfo+ ais <- getAddressInfo (Just "127.0.0.1") (Just "http")- aiNUMERICHOST - `onException` p 0 :: IO [AddrInfo INET STREAM TCP]+ aiNumericHost + `onException` p 0 :: IO [AddressInfo Inet Stream TCP] when (length ais /= 1) (e 1) let [ai] = ais- when (addrCanonName ai /= Nothing) (e 2)- let addr = addrAddress ai- when (sinPort addr /= 80) (e 3)- when (sinAddr addr /= inaddrLOOPBACK) (e 4)+ when (canonicalName ai /= Nothing) (e 2)+ let sa = socketAddress ai+ when (port sa /= 80) (e 3)+ when (address sa /= Inet.loopback) (e 4) where p i = print ("t0001." ++ show i) e i = error ("t0001." ++ show i) t0002 :: IO () t0002 = do- let x = getAddrInfo+ let x = getAddressInfo Nothing Nothing- mempty :: IO [AddrInfo INET STREAM TCP]- eui <- tryJust (\ex@(AddrInfoException _)-> if ex == eaiNONAME then Just () else Nothing)+ mempty :: IO [AddressInfo Inet Stream TCP]+ eui <- tryJust (\ex@(AddressInfoException _)-> if ex == eaiNoName then Just () else Nothing) (x `onException` p 0) when (eui /= Left ()) (e 1) where@@ -51,16 +51,16 @@ -- but not in the first one. t0003 :: IO () t0003 = do- x <- getAddrInfo+ x <- getAddressInfo (Just "localhost") Nothing mempty - `onException` p 0:: IO [AddrInfo INET6 STREAM TCP]- y <- getAddrInfo+ `onException` p 0:: IO [AddressInfo Inet6 Stream TCP]+ y <- getAddressInfo (Just "localhost") Nothing- (aiALL `mappend` aiV4MAPPED)- `onException` p 1 :: IO [AddrInfo INET6 STREAM TCP]+ (aiAll `mappend` aiV4Mapped)+ `onException` p 1 :: IO [AddressInfo Inet6 Stream TCP] when (length x == length y) (e 2) where p i = print ("t0003." ++ show i)
tests/IPV6_V6ONLY.hs view
@@ -8,8 +8,8 @@ import Control.Concurrent import Control.Concurrent.Async import System.Socket-import System.Socket.Family.INET-import System.Socket.Family.INET6+import System.Socket.Family.Inet as Inet+import System.Socket.Family.Inet6 as Inet6 import System.Exit main :: IO ()@@ -21,8 +21,8 @@ t0001 = bracket ( do- server <- socket `onException` p 0 :: IO (Socket INET6 DGRAM UDP)- client <- socket `onException` p 1 :: IO (Socket INET DGRAM UDP)+ server <- socket `onException` p 0 :: IO (Socket Inet6 Datagram UDP)+ client <- socket `onException` p 1 :: IO (Socket Inet Datagram UDP) return (server, client) ) (\(server,client)-> do@@ -30,14 +30,14 @@ close client `onException` p 3 ) (\(server,client)-> do- setSockOpt server (IPV6_V6ONLY True) `onException` p 4- bind server (SockAddrIn6 7777 0 in6addrANY 0) `onException` p 5+ setSocketOption server (V6Only True) `onException` p 4+ bind server (SocketAddressInet6 Inet6.any 7777 mempty 0) `onException` p 5 threadDelay 1000000 -- wait for the listening socket being set up- sendTo client "PING" mempty (SockAddrIn 7777 inaddrLOOPBACK)- `onException` p 6+ sendTo client "PING" mempty (SocketAddressInet Inet.loopback 7777)+ `onException` p 6 eith <- race- ( recvFrom server 4096 mempty `onException` p 7 >> return () )+ ( receiveFrom server 4096 mempty `onException` p 7 >> return () ) ( threadDelay 1000000 ) case eith of Left () -> e 8 -- we didn't expect receiving a msg@@ -51,8 +51,8 @@ t0002 = bracket ( do- server <- socket `onException` p 0 :: IO (Socket INET6 DGRAM UDP)- client <- socket `onException` p 1 :: IO (Socket INET DGRAM UDP)+ server <- socket `onException` p 0 :: IO (Socket Inet6 Datagram UDP)+ client <- socket `onException` p 1 :: IO (Socket Inet Datagram UDP) return (server, client) ) (\(server,client)-> do@@ -60,14 +60,13 @@ close client `onException` p 3 ) (\(server,client)-> do- setSockOpt server (IPV6_V6ONLY False) `onException` p 4- bind server (SockAddrIn6 7778 0 in6addrANY 0) `onException` p 5+ setSocketOption server (V6Only False) `onException` p 4+ bind server (SocketAddressInet6 Inet6.any 7778 mempty 0) `onException` p 5 threadDelay 1000000 -- wait for the listening socket being set up- sendTo client "PING" mempty (SockAddrIn 7778 inaddrLOOPBACK)- `onException` p 6+ sendTo client "PING" mempty (SocketAddressInet Inet.loopback 7778) `onException` p 6 eith <- race- ( recvFrom server 4096 mempty `onException` p 7 >> return ())+ ( receiveFrom server 4096 mempty `onException` p 7 >> return ()) ( threadDelay 1000000 ) case eith of Left () -> return () -- we received the expected msg
tests/NonBlockingIO.hs view
@@ -8,7 +8,7 @@ import Control.Concurrent import Control.Concurrent.Async import System.Socket-import System.Socket.Family.INET+import System.Socket.Family.Inet as Inet import System.Exit main :: IO ()@@ -26,9 +26,9 @@ -- environment. t0001 :: IO () t0001 = do- s <- socket `onException` e 0 :: IO (Socket INET STREAM TCP)- setSockOpt s (SO_REUSEADDR True) `onException` e 1- bind s (SockAddrIn 8080 inaddrLOOPBACK) `onException` e 2+ s <- socket `onException` e 0 :: IO (Socket Inet Stream TCP)+ setSocketOption s (ReuseAddress True) `onException` e 1+ bind s (SocketAddressInet Inet.loopback 8080) `onException` e 2 listen s 5 `onException` e 3 a <- async (accept s) `onException` e 4 threadDelay 1000000 -- make sure the async call really got enough time to start
tests/PingPong.hs view
@@ -8,7 +8,7 @@ import Control.Concurrent import Control.Concurrent.Async import System.Socket-import System.Socket.Family.INET+import System.Socket.Family.Inet as Inet import System.Exit main :: IO ()@@ -17,9 +17,9 @@ t0001 :: IO () t0001 = do- server <- socket `onException` e 0 :: IO (Socket INET STREAM TCP)- client <- socket `onException` e 1 :: IO (Socket INET STREAM TCP)- setSockOpt server (SO_REUSEADDR True) `onException` e 2+ server <- socket `onException` e 0 :: IO (Socket Inet Stream TCP)+ client <- socket `onException` e 1 :: IO (Socket Inet Stream TCP)+ setSocketOption server (ReuseAddress True) `onException` e 2 bind server addr `onException` e 3 listen server 5 `onException` e 4 connect client addr `onException` e 5@@ -39,10 +39,10 @@ when (i < 10000) (e 16) where- addr = SockAddrIn 8080 inaddrLOOPBACK+ addr = SocketAddressInet Inet.loopback 8080 e i = print ("t0001." ++ show i) loop sock index = ( do- ping <- recv sock 4096 mempty+ ping <- receive sock 4096 mempty when (ping /= "Ping!") (e 14) send sock ping mempty loop sock (index + 1)
tests/TCP-sendAndRecvAll.hs view
@@ -10,14 +10,14 @@ import qualified Data.ByteString.Lazy as LBS import System.Socket-import System.Socket.Family.INET+import System.Socket.Family.Inet as Inet -- | This tries to send and receive an extremely huge message (currently 128MB). main :: IO () main = bracket- ( do server <- socket `onException` print "E01" :: IO (Socket INET STREAM TCP)- client <- socket `onException` print "E02" :: IO (Socket INET STREAM TCP)+ ( do server <- socket `onException` print "E01" :: IO (Socket Inet Stream TCP)+ client <- socket `onException` print "E02" :: IO (Socket Inet Stream TCP) return (server, client) ) (\(server,client)-> do@@ -29,7 +29,7 @@ listen server 5 `onException` print "E07" serverRecv <- async $ do (peerSock, peerAddr) <- accept server `onException` print "E08"- recvAll peerSock msgSize mempty `onException` print "E09"+ receiveAll peerSock msgSize mempty `onException` print "E09" threadDelay 100000 connect client addr `onException` print "E11"@@ -42,4 +42,4 @@ where msgSize = 128*1024*1024 + 1 :: Int64 msg = LBS.replicate msgSize 23- addr = SockAddrIn 7777 inaddrLOOPBACK+ addr = SocketAddressInet Inet.loopback 7777
tests/TCP.hs view
@@ -7,17 +7,17 @@ import Control.Concurrent import Control.Concurrent.Async import System.Socket-import System.Socket.Family.INET-import System.Socket.Family.INET6+import System.Socket.Family.Inet as Inet+import System.Socket.Family.Inet6 as Inet6 import System.Exit main :: IO () main = do - test "test0001.01" $ test0001 (undefined :: Socket INET STREAM TCP) localhost- test "test0001.02" $ test0001 (undefined :: Socket INET6 STREAM TCP) localhost6+ test "test0001.01" $ test0001 (undefined :: Socket Inet Stream TCP) localhost+ test "test0001.02" $ test0001 (undefined :: Socket Inet6 Stream TCP) localhost6 -- Test send and receive on connection oriented sockets (i.e. TCP).-test0001 :: (Family f, Type t, Protocol p) => Socket f t p -> SockAddr f -> IO (Either String String)+test0001 :: (Family f, Type t, Protocol p) => Socket f t p -> SocketAddress f -> IO (Either String String) test0001 dummy addr = bracket ( do server <- socket `asTypeOf` return dummy `onException` print "E01"@@ -29,12 +29,12 @@ close client `onException` print "E04" ) (\(server,client)-> do- setSockOpt server (SO_REUSEADDR True) `onException` print "E05"+ setSocketOption server (ReuseAddress True) `onException` print "E05" bind server addr `onException` print "E06" listen server 5 `onException` print "E07" serverRecv <- async $ do (peerSock, peerAddr) <- accept server `onException` print "E08"- recv peerSock 4096 mempty `onException` print "E09"+ receive peerSock 4096 mempty `onException` print "E09" connect client addr `onException` print "E11" send client helloWorld mempty `onException` print "E12" msg <- wait serverRecv `onException` print "E13"@@ -47,21 +47,20 @@ where helloWorld = "Hello world!" --localhost :: SockAddrIn+localhost :: SocketAddressInet localhost =- SockAddrIn- { sinPort = 7777- , sinAddr = inaddrLOOPBACK+ SocketAddressInet+ { Inet.port = 7777+ , Inet.address = Inet.loopback } -localhost6 :: SockAddrIn6+localhost6 :: SocketAddressInet6 localhost6 =- SockAddrIn6- { sin6Port = 7777- , sin6Addr = in6addrLOOPBACK- , sin6Flowinfo = 0- , sin6ScopeId = 0+ SocketAddressInet6+ { Inet6.port = 7777+ , Inet6.address = Inet6.loopback+ , Inet6.flowInfo = mempty+ , Inet6.scopeId = 0 } test :: String -> IO (Either String String) -> IO ()
tests/UDP.hs view
@@ -7,17 +7,17 @@ import Control.Concurrent import Control.Concurrent.Async import System.Socket-import System.Socket.Family.INET-import System.Socket.Family.INET6+import System.Socket.Family.Inet as Inet+import System.Socket.Family.Inet6 as Inet6 import System.Exit main :: IO () main = do - test "INET" (undefined :: Socket INET DGRAM UDP) localhost- test "INET6" (undefined :: Socket INET6 DGRAM UDP) localhost6+ test "Inet" (undefined :: Socket Inet Datagram UDP) localhost+ test "Inet6" (undefined :: Socket Inet6 Datagram UDP) localhost6 -- Test stateless sockets (i.e. UDP).-test :: (Family f, Type t, Protocol p) => String -> Socket f t p -> SockAddr f -> IO ()+test :: (Family f, Type t, Protocol p) => String -> Socket f t p -> SocketAddress f -> IO () test inet dummy addr = do server <- socket `asTypeOf` return dummy `onException` p 1 client <- socket `asTypeOf` return dummy `onException` p 2@@ -26,7 +26,7 @@ ((msg,peeraddr),_) <- concurrently ( do- recvFrom server 4096 mempty `onException` p 5+ receiveFrom server 4096 mempty `onException` p 5 ) ( do -- This is a race condition:@@ -47,18 +47,18 @@ e i = error (inet ++ ": " ++ show i) p i = print (inet ++ ": " ++ show i) -localhost :: SockAddrIn+localhost :: SocketAddressInet localhost =- SockAddrIn- { sinPort = 7777- , sinAddr = inaddrLOOPBACK+ SocketAddressInet+ { Inet.port = 7777+ , Inet.address = Inet.loopback } -localhost6 :: SockAddrIn6+localhost6 :: SocketAddressInet6 localhost6 =- SockAddrIn6- { sin6Port = 7777- , sin6Addr = in6addrLOOPBACK- , sin6Flowinfo = 0- , sin6ScopeId = 0+ SocketAddressInet6+ { Inet6.port = 7777+ , Inet6.address = Inet6.loopback+ , Inet6.flowInfo = mempty+ , Inet6.scopeId = 0 }