network-3.0.1.1: tests/Network/SocketSpec.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.SocketSpec (main, spec) where
import Control.Concurrent.MVar (readMVar)
import Control.Monad
import Network.Socket
import Network.Socket.ByteString
import Network.Test.Common
import Test.Hspec
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "connect" $ do
let
hints = defaultHints { addrSocketType = Stream }
connect' serverPort = do
addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
connect sock (addrAddress addr)
return sock
it "fails to connect and throws an IOException" $ do
connect' (8080 :: Int) `shouldThrow` anyIOException
it "successfully connects to a socket with no exception" $ do
withPort $ \portVar -> test (tcp return portVar)
{ clientSetup = readMVar portVar >>= connect'
}
describe "bind" $ do
let hints = defaultHints
{ addrFlags = [AI_PASSIVE]
, addrSocketType = Stream
}
it "successfully binds to an ipv6 socket" $ do
addr:_ <- getAddrInfo (Just hints) (Just serverAddr6) Nothing
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
bind sock $ addrAddress addr
it "fails to bind to unknown ipv6 socket" $ do
addr:_ <- getAddrInfo (Just hints) (Just "::6") Nothing
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
bind sock (addrAddress addr) `shouldThrow` anyIOException
describe "UserTimeout" $ do
it "can be set" $ do
when (isSupportedSocketOption UserTimeout) $ do
sock <- socket AF_INET Stream defaultProtocol
setSocketOption sock UserTimeout 1000
getSocketOption sock UserTimeout `shouldReturn` 1000
setSocketOption sock UserTimeout 2000
getSocketOption sock UserTimeout `shouldReturn` 2000
close sock
describe "getAddrInfo" $ do
it "works for IPv4 address" $ do
let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }
AddrInfo{addrAddress = (SockAddrInet _ hostAddr)}:_ <-
getAddrInfo (Just hints) (Just "127.128.129.130") Nothing
hostAddressToTuple hostAddr `shouldBe` (0x7f, 0x80, 0x81, 0x82)
#if defined(IPV6_SOCKET_SUPPORT)
it "works for IPv6 address" $ do
let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }
host = "2001:0db8:85a3:0000:0000:8a2e:0370:7334"
AddrInfo{addrAddress = (SockAddrInet6 _ _ hostAddr _)}:_ <-
getAddrInfo (Just hints) (Just host) Nothing
hostAddress6ToTuple hostAddr
`shouldBe` (0x2001, 0x0db8, 0x85a3, 0x0000, 0x0000, 0x8a2e, 0x0370, 0x7334)
#endif
it "does not cause segfault on macOS 10.8.2 due to AI_NUMERICSERV" $ do
let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }
void $ getAddrInfo (Just hints) (Just "localhost") Nothing
#if defined(mingw32_HOST_OS)
let lpdevname = "loopback_0"
#else
let lpdevname = "lo"
#endif
describe "ifNameToIndex" $ do
it "converts a name to an index" $
ifNameToIndex lpdevname `shouldReturn` Just 1
describe "ifIndexToName" $ do
it "converts an index to a name" $
ifIndexToName 1 `shouldReturn` Just lpdevname
when isUnixDomainSocketAvailable $ do
context "unix sockets" $ do
it "basic unix sockets end-to-end" $ do
let client sock = send sock testMsg
server (sock, addr) = do
recv sock 1024 `shouldReturn` testMsg
addr `shouldBe` (SockAddrUnix "")
test . setClientAction client $ unixWithUnlink unixAddr server
#ifdef linux_HOST_OS
it "can end-to-end with an abstract socket" $ do
let
abstractAddress = toEnum 0:"/haskell/network/abstract"
client sock = send sock testMsg
server (sock, addr) = do
recv sock 1024 `shouldReturn` testMsg
addr `shouldBe` (SockAddrUnix "")
test . setClientAction client $
unix abstractAddress (const $ return ()) $ server
#endif
describe "socketPair" $ do
it "can send and recieve bi-directionally" $ do
(s1, s2) <- socketPair AF_UNIX Stream defaultProtocol
void $ send s1 testMsg
recv s2 1024 `shouldReturn` testMsg
void $ send s2 testMsg
recv s1 1024 `shouldReturn` testMsg
describe "sendFd/recvFd" $ do
it "can send and recieve a file descriptor" $ do
(s1, s2) <- socketPair AF_UNIX Stream defaultProtocol
(s3, s4) <- socketPair AF_UNIX Stream defaultProtocol
fd1 <- fdSocket s1
void $ sendFd s3 fd1
fd1' <- recvFd s4
s1' <- mkSocket fd1'
void $ send s1' testMsg
recv s2 1024 `shouldReturn` testMsg
-- On various BSD systems the peer credentials are exchanged during
-- connect(), and this does not happen with `socketpair()`. Therefore,
-- we must actually set up a listener and connect, rather than use a
-- socketpair().
--
describe "getPeerCredential" $ do
it "can return something" $ do
-- It would be useful to check that we did not get garbage
-- back, but rather the actual uid of the test program. For
-- that we'd need System.Posix.User, but that is not available
-- under Windows. For now, accept the risk that we did not get
-- the right answer.
--
let server (sock, _) = do
(_, uid, _) <- getPeerCredential sock
uid `shouldNotBe` Nothing
client sock = do
(_, uid, _) <- getPeerCredential sock
uid `shouldNotBe` Nothing
test . setClientAction client $ unixWithUnlink unixAddr server
{- The below test fails on many *BSD systems, because the getsockopt()
call that underlies getpeereid() does not have the same meaning for
all address families, but the C-library was not checking that the
provided sock is an AF_UNIX socket. This will fixed some day, but
we should not fail on those systems in the mean-time. The upstream
C-library fix is to call getsockname() and check the address family
before calling `getpeereid()`. We could duplicate that in our own
code, and then this test would work on those platforms that have
`getpeereid()` and not the SO_PEERCRED socket option.
it "return nothing for non-UNIX-domain socket" $ do
when isUnixDomainSocketAvailable $ do
s <- socket AF_INET Stream defaultProtocol
cred1 <- getPeerCredential s
cred1 `shouldBe` (Nothing,Nothing,Nothing)
-}