network 2.4.1.0 → 2.4.1.1
raw patch · 6 files changed
+144/−65 lines, 6 filesdep +test-framework-quickcheck2PVP ok
version bump matches the API change (PVP)
Dependencies added: test-framework-quickcheck2
API changes (from Hackage documentation)
Files
- Network/Socket.hsc +3/−0
- Network/URI.hs +44/−3
- include/HsNet.h +4/−0
- network.cabal +3/−2
- tests/Simple.hs +82/−60
- tests/uri001.hs +8/−0
Network/Socket.hsc view
@@ -1305,6 +1305,9 @@ }) poke p (AddrInfo flags family socketType protocol _ _) = do+#if defined(darwin_HOST_OS)+ zeroMemory p (#const sizeof(struct addrinfo))+#endif c_stype <- packSocketTypeOrThrow "AddrInfo.poke" socketType (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags)
Network/URI.hs view
@@ -970,9 +970,50 @@ -- unEscapeString :: String -> String unEscapeString [] = ""-unEscapeString ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 =- chr (digitToInt x1 * 16 + digitToInt x2) : unEscapeString s-unEscapeString (c:s) = c : unEscapeString s+unEscapeString s@(c:cs) = case unEscapeByte s of+ Just (byte, rest) -> unEscapeUtf8 byte rest+ Nothing -> c : unEscapeString cs++unEscapeByte :: String -> Maybe (Int, String)+unEscapeByte ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 =+ Just (digitToInt x1 * 16 + digitToInt x2, s)+unEscapeByte _ = Nothing++-- Adapted from http://hackage.haskell.org/package/utf8-string+-- by Eric Mertens, BSD3+unEscapeUtf8 :: Int -> String -> String+unEscapeUtf8 c rest+ | c < 0x80 = chr c : unEscapeString rest+ | c < 0xc0 = replacement_character : unEscapeString rest+ | c < 0xe0 = multi1+ | c < 0xf0 = multi_byte 2 0xf 0x800+ | c < 0xf8 = multi_byte 3 0x7 0x10000+ | c < 0xfc = multi_byte 4 0x3 0x200000+ | c < 0xfe = multi_byte 5 0x1 0x4000000+ | otherwise = replacement_character : unEscapeString rest+ where+ replacement_character = '\xfffd'+ multi1 = case unEscapeByte rest of+ Just (c1, ds) | c1 .&. 0xc0 == 0x80 ->+ let d = ((fromEnum c .&. 0x1f) `shiftL` 6) .|. fromEnum (c1 .&. 0x3f)+ in if d >= 0x000080 then toEnum d : unEscapeString ds+ else replacement_character : unEscapeString ds+ _ -> replacement_character : unEscapeString rest++ multi_byte i mask overlong =+ aux i rest (unEscapeByte rest) (c .&. mask)+ where+ aux 0 rs _ acc+ | overlong <= acc && acc <= 0x10ffff &&+ (acc < 0xd800 || 0xdfff < acc) &&+ (acc < 0xfffe || 0xffff < acc) = chr acc : unEscapeString rs+ | otherwise = replacement_character : unEscapeString rs++ aux n _ (Just (r, rs)) acc+ | r .&. 0xc0 == 0x80 = aux (n-1) rs (unEscapeByte rs)+ $! shiftL acc 6 .|. (r .&. 0x3f)++ aux _ rs _ _ = replacement_character : unEscapeString rs ------------------------------------------------------------ -- Resolving a relative URI relative to a base URI
include/HsNet.h view
@@ -172,4 +172,8 @@ # endif #endif +#if !defined(IOV_MAX)+# define IOV_MAX 1024+#endif+ #endif /* HSNET_H */
network.cabal view
@@ -1,5 +1,5 @@ name: network-version: 2.4.1.0+version: 2.4.1.1 license: BSD3 license-file: LICENSE maintainer: Johan Tibell <johan.tibell@gmail.com>@@ -80,7 +80,8 @@ HUnit, network, test-framework,- test-framework-hunit+ test-framework-hunit,+ test-framework-quickcheck2 source-repository head type: git
tests/Simple.hs view
@@ -3,7 +3,7 @@ module Main where import Control.Concurrent (ThreadId, forkIO, myThreadId)-import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, readMVar) import qualified Control.Exception as E import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C@@ -15,9 +15,6 @@ ------------------------------------------------------------------------ -serverPort :: PortNumber-serverPort = fromIntegral (3000 :: Int)- serverAddr :: String serverAddr = "127.0.0.1" @@ -32,84 +29,88 @@ testSend :: Assertion testSend = tcpTest client server- where- server sock = recv sock 1024 >>= (@=?) testMsg- client sock = send sock testMsg+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock = send sock testMsg testSendAll :: Assertion testSendAll = tcpTest client server- where- server sock = recv sock 1024 >>= (@=?) testMsg- client sock = sendAll sock testMsg+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock = sendAll sock testMsg testSendTo :: Assertion testSendTo = udpTest client server- where- server sock = recv sock 1024 >>= (@=?) testMsg- client sock = do addr <- inet_addr serverAddr- sendTo sock testMsg (SockAddrInet serverPort addr)+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock serverPort = do+ addr <- inet_addr serverAddr+ sendTo sock testMsg (SockAddrInet serverPort addr) testSendAllTo :: Assertion testSendAllTo = udpTest client server- where- server sock = recv sock 1024 >>= (@=?) testMsg- client sock = do addr <- inet_addr serverAddr- sendAllTo sock testMsg (SockAddrInet serverPort addr)+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock serverPort = do+ addr <- inet_addr serverAddr+ sendAllTo sock testMsg (SockAddrInet serverPort addr) testSendMany :: Assertion testSendMany = tcpTest client server- where- server sock = recv sock 1024 >>= (@=?) (S.append seg1 seg2)- client sock = sendMany sock [seg1, seg2]+ where+ server sock = recv sock 1024 >>= (@=?) (S.append seg1 seg2)+ client sock = sendMany sock [seg1, seg2] - seg1 = C.pack "This is a "- seg2 = C.pack "test message."+ seg1 = C.pack "This is a "+ seg2 = C.pack "test message." testSendManyTo :: Assertion testSendManyTo = udpTest client server- where- server sock = recv sock 1024 >>= (@=?) (S.append seg1 seg2)- client sock = do addr <- inet_addr serverAddr- sendManyTo sock [seg1, seg2]- (SockAddrInet serverPort addr)+ where+ server sock = recv sock 1024 >>= (@=?) (S.append seg1 seg2)+ client sock serverPort = do+ addr <- inet_addr serverAddr+ sendManyTo sock [seg1, seg2] (SockAddrInet serverPort addr) - seg1 = C.pack "This is a "- seg2 = C.pack "test message."+ seg1 = C.pack "This is a "+ seg2 = C.pack "test message." testRecv :: Assertion testRecv = tcpTest client server- where- server sock = recv sock 1024 >>= (@=?) testMsg- client sock = send sock testMsg+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock = send sock testMsg testOverFlowRecv :: Assertion testOverFlowRecv = tcpTest client server- where- server sock = do seg1 <- recv sock (S.length testMsg - 3)- seg2 <- recv sock 1024- let msg = S.append seg1 seg2- testMsg @=? msg+ where+ server sock = do seg1 <- recv sock (S.length testMsg - 3)+ seg2 <- recv sock 1024+ let msg = S.append seg1 seg2+ testMsg @=? msg - client sock = send sock testMsg+ client sock = send sock testMsg testRecvFrom :: Assertion testRecvFrom = tcpTest client server- where- server sock = do (msg, _) <- recvFrom sock 1024- testMsg @=? msg+ where+ server sock = do (msg, _) <- recvFrom sock 1024+ testMsg @=? msg - client sock = do addr <- inet_addr serverAddr- sendTo sock testMsg (SockAddrInet serverPort addr)+ client sock = do+ serverPort <- getPeerPort sock+ addr <- inet_addr serverAddr+ sendTo sock testMsg (SockAddrInet serverPort addr) testOverFlowRecvFrom :: Assertion testOverFlowRecvFrom = tcpTest client server- where- server sock = do (seg1, _) <- recvFrom sock (S.length testMsg - 3)- (seg2, _) <- recvFrom sock 1024- let msg = S.append seg1 seg2- testMsg @=? msg+ where+ server sock = do (seg1, _) <- recvFrom sock (S.length testMsg - 3)+ (seg2, _) <- recvFrom sock 1024+ let msg = S.append seg1 seg2+ testMsg @=? msg - client sock = send sock testMsg+ client sock = send sock testMsg ------------------------------------------------------------------------ -- Other@@ -139,27 +140,41 @@ ------------------------------------------------------------------------ -- Test helpers +-- | Returns the 'PortNumber' of the peer. Will throw an 'error' if+-- used on a non-IP socket.+getPeerPort :: Socket -> IO PortNumber+getPeerPort sock = do+ sockAddr <- getPeerName sock+ case sockAddr of+ (SockAddrInet port _) -> return port+ (SockAddrInet6 port _ _ _) -> return port+ _ -> error "getPeerPort: only works with IP sockets"+ -- | Establish a connection between client and server and then run -- 'clientAct' and 'serverAct', in different threads. Both actions -- get passed a connected 'Socket', used for communicating between -- client and server. 'tcpTest' makes sure that the 'Socket' is -- closed after the actions have run. tcpTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()-tcpTest clientAct serverAct =- test clientSetup clientAct serverSetup server+tcpTest clientAct serverAct = do+ portVar <- newEmptyMVar+ test (clientSetup portVar) clientAct (serverSetup portVar) server where- clientSetup = do+ clientSetup portVar = do sock <- socket AF_INET Stream defaultProtocol addr <- inet_addr serverAddr+ serverPort <- readMVar portVar connect sock $ SockAddrInet serverPort addr return sock - serverSetup = do+ serverSetup portVar = do sock <- socket AF_INET Stream defaultProtocol setSocketOption sock ReuseAddr 1 addr <- inet_addr serverAddr- bindSocket sock (SockAddrInet serverPort addr)+ bindSocket sock (SockAddrInet aNY_PORT addr) listen sock 1+ serverPort <- socketPort sock+ putMVar portVar serverPort return sock server sock = do@@ -169,17 +184,24 @@ -- | Create an unconnected 'Socket' for sending UDP and receiving -- datagrams and then run 'clientAct' and 'serverAct'.-udpTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()-udpTest clientAct serverAct =- test clientSetup clientAct serverSetup serverAct+udpTest :: (Socket -> PortNumber -> IO a) -> (Socket -> IO b) -> IO ()+udpTest clientAct serverAct = do+ portVar <- newEmptyMVar+ test clientSetup (client portVar) (serverSetup portVar) serverAct where clientSetup = socket AF_INET Datagram defaultProtocol - serverSetup = do+ client portVar sock = do+ serverPort <- readMVar portVar+ clientAct sock serverPort++ serverSetup portVar = do sock <- socket AF_INET Datagram defaultProtocol setSocketOption sock ReuseAddr 1 addr <- inet_addr serverAddr- bindSocket sock (SockAddrInet serverPort addr)+ bindSocket sock (SockAddrInet aNY_PORT addr)+ serverPort <- socketPort sock+ putMVar portVar serverPort return sock -- | Run a client/server pair and synchronize them so that the server
tests/uri001.hs view
@@ -56,6 +56,7 @@ import System.IO (openFile, IOMode(WriteMode), hClose) import qualified Test.Framework as TF import qualified Test.Framework.Providers.HUnit as TF+import qualified Test.Framework.Providers.QuickCheck2 as TF -- Test supplied string for valid URI reference syntax -- isValidURIRef :: String -> Bool@@ -1103,6 +1104,12 @@ "hello%C3%B8%C2%A9%E6%97%A5%E6%9C%AC" (escapeURIString isUnescapedInURIComponent "helloø©日本") +propEscapeUnEscapeLoop :: String -> Bool+propEscapeUnEscapeLoop s = s == (unEscapeString $! escaped)+ where+ escaped = escapeURIString (const False) s+ {-# NOINLINE escaped #-}+ testEscapeURIString = TF.testGroup "testEscapeURIString" [ TF.testCase "testEscapeURIString01" testEscapeURIString01 , TF.testCase "testEscapeURIString02" testEscapeURIString02@@ -1110,6 +1117,7 @@ , TF.testCase "testEscapeURIString04" testEscapeURIString04 , TF.testCase "testEscapeURIString05" testEscapeURIString05 , TF.testCase "testEscapeURIString06" testEscapeURIString06+ , TF.testProperty "propEscapeUnEscapeLoop" propEscapeUnEscapeLoop ] -- URI string normalization tests