diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,14 @@ +0.5.0.0 Lars Petersen 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 2015-06-17 * tar-ball did not contain relevant source files. diff --git a/CONTRIBUTORS.txt b/CONTRIBUTORS.txt new file mode 100644 --- /dev/null +++ b/CONTRIBUTORS.txt @@ -0,0 +1,2 @@ +Michael Fox (reported issue #7) +Bryan O'Sullivan (legitimately criticised the bizarre naming) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/platform/linux/src/System/Socket/Internal/Platform.hsc b/platform/linux/src/System/Socket/Internal/Platform.hsc --- a/platform/linux/src/System/Socket/Internal/Platform.hsc +++ b/platform/linux/src/System/Socket/Internal/Platform.hsc @@ -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 diff --git a/platform/win32/src/System/Socket/Internal/Platform.hsc b/platform/win32/src/System/Socket/Internal/Platform.hsc --- a/platform/win32/src/System/Socket/Internal/Platform.hsc +++ b/platform/win32/src/System/Socket/Internal/Platform.hsc @@ -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 diff --git a/socket.cabal b/socket.cabal --- a/socket.cabal +++ b/socket.cabal @@ -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 diff --git a/src/System/Socket.hsc b/src/System/Socket.hsc --- a/src/System/Socket.hsc +++ b/src/System/Socket.hsc @@ -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) diff --git a/src/System/Socket/Family.hs b/src/System/Socket/Family.hs --- a/src/System/Socket/Family.hs +++ b/src/System/Socket/Family.hs @@ -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 diff --git a/src/System/Socket/Family/INET.hsc b/src/System/Socket/Family/INET.hsc deleted file mode 100644 --- a/src/System/Socket/Family/INET.hsc +++ /dev/null @@ -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) diff --git a/src/System/Socket/Family/INET6.hsc b/src/System/Socket/Family/INET6.hsc deleted file mode 100644 --- a/src/System/Socket/Family/INET6.hsc +++ /dev/null @@ -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 diff --git a/src/System/Socket/Family/Inet.hsc b/src/System/Socket/Family/Inet.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Family/Inet.hsc @@ -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) diff --git a/src/System/Socket/Family/Inet6.hsc b/src/System/Socket/Family/Inet6.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Family/Inet6.hsc @@ -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 diff --git a/src/System/Socket/Internal/AddrInfo.hsc b/src/System/Socket/Internal/AddrInfo.hsc deleted file mode 100644 --- a/src/System/Socket/Internal/AddrInfo.hsc +++ /dev/null @@ -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) diff --git a/src/System/Socket/Internal/AddressInfo.hsc b/src/System/Socket/Internal/AddressInfo.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Internal/AddressInfo.hsc @@ -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) diff --git a/src/System/Socket/Internal/Exception.hsc b/src/System/Socket/Internal/Exception.hsc --- a/src/System/Socket/Internal/Exception.hsc +++ b/src/System/Socket/Internal/Exception.hsc @@ -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) diff --git a/src/System/Socket/Internal/Message.hsc b/src/System/Socket/Internal/Message.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Internal/Message.hsc @@ -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) diff --git a/src/System/Socket/Internal/Msg.hsc b/src/System/Socket/Internal/Msg.hsc deleted file mode 100644 --- a/src/System/Socket/Internal/Msg.hsc +++ /dev/null @@ -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) diff --git a/src/System/Socket/Internal/Socket.hsc b/src/System/Socket/Internal/Socket.hsc --- a/src/System/Socket/Internal/Socket.hsc +++ b/src/System/Socket/Internal/Socket.hsc @@ -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 diff --git a/src/System/Socket/Type/DGRAM.hsc b/src/System/Socket/Type/DGRAM.hsc deleted file mode 100644 --- a/src/System/Socket/Type/DGRAM.hsc +++ /dev/null @@ -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) diff --git a/src/System/Socket/Type/Datagram.hsc b/src/System/Socket/Type/Datagram.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Type/Datagram.hsc @@ -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) diff --git a/src/System/Socket/Type/RAW.hsc b/src/System/Socket/Type/RAW.hsc deleted file mode 100644 --- a/src/System/Socket/Type/RAW.hsc +++ /dev/null @@ -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) diff --git a/src/System/Socket/Type/Raw.hsc b/src/System/Socket/Type/Raw.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Type/Raw.hsc @@ -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) diff --git a/src/System/Socket/Type/SEQPACKET.hsc b/src/System/Socket/Type/SEQPACKET.hsc deleted file mode 100644 --- a/src/System/Socket/Type/SEQPACKET.hsc +++ /dev/null @@ -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) diff --git a/src/System/Socket/Type/STREAM.hsc b/src/System/Socket/Type/STREAM.hsc deleted file mode 100644 --- a/src/System/Socket/Type/STREAM.hsc +++ /dev/null @@ -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) diff --git a/src/System/Socket/Type/SequentialPacket.hsc b/src/System/Socket/Type/SequentialPacket.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Type/SequentialPacket.hsc @@ -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) diff --git a/src/System/Socket/Type/Stream.hsc b/src/System/Socket/Type/Stream.hsc new file mode 100644 --- /dev/null +++ b/src/System/Socket/Type/Stream.hsc @@ -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) diff --git a/src/System/Socket/Unsafe.hsc b/src/System/Socket/Unsafe.hsc --- a/src/System/Socket/Unsafe.hsc +++ b/src/System/Socket/Unsafe.hsc @@ -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 diff --git a/tests/AddrInfo.hs b/tests/AddrInfo.hs --- a/tests/AddrInfo.hs +++ b/tests/AddrInfo.hs @@ -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) diff --git a/tests/IPV6_V6ONLY.hs b/tests/IPV6_V6ONLY.hs --- a/tests/IPV6_V6ONLY.hs +++ b/tests/IPV6_V6ONLY.hs @@ -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 diff --git a/tests/NonBlockingIO.hs b/tests/NonBlockingIO.hs --- a/tests/NonBlockingIO.hs +++ b/tests/NonBlockingIO.hs @@ -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 diff --git a/tests/PingPong.hs b/tests/PingPong.hs --- a/tests/PingPong.hs +++ b/tests/PingPong.hs @@ -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) diff --git a/tests/TCP-sendAndRecvAll.hs b/tests/TCP-sendAndRecvAll.hs --- a/tests/TCP-sendAndRecvAll.hs +++ b/tests/TCP-sendAndRecvAll.hs @@ -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 diff --git a/tests/TCP.hs b/tests/TCP.hs --- a/tests/TCP.hs +++ b/tests/TCP.hs @@ -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 () diff --git a/tests/UDP.hs b/tests/UDP.hs --- a/tests/UDP.hs +++ b/tests/UDP.hs @@ -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 }