network 2.2.1.10 → 2.2.3
raw patch · 18 files changed
+2259/−66 lines, 18 filesdep +bytestringdep +unixsetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: bytestring, unix
API changes (from Hackage documentation)
+ Network.Socket.ByteString: recv :: Socket -> Int -> IO ByteString
+ Network.Socket.ByteString: recvFrom :: Socket -> Int -> IO (ByteString, SockAddr)
+ Network.Socket.ByteString: send :: Socket -> ByteString -> IO Int
+ Network.Socket.ByteString: sendAll :: Socket -> ByteString -> IO ()
+ Network.Socket.ByteString: sendAllTo :: Socket -> ByteString -> SockAddr -> IO ()
+ Network.Socket.ByteString: sendMany :: Socket -> [ByteString] -> IO ()
+ Network.Socket.ByteString: sendManyTo :: Socket -> [ByteString] -> SockAddr -> IO ()
+ Network.Socket.ByteString: sendTo :: Socket -> ByteString -> SockAddr -> IO Int
+ Network.Socket.ByteString.Lazy: getContents :: Socket -> IO ByteString
+ Network.Socket.ByteString.Lazy: recv :: Socket -> Int64 -> IO ByteString
+ Network.Socket.ByteString.Lazy: send :: Socket -> ByteString -> IO Int64
+ Network.Socket.ByteString.Lazy: sendAll :: Socket -> ByteString -> IO ()
- Network.Socket: throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO ()
+ Network.Socket: throwSocketErrorIfMinus1_ :: (Num a) => String -> IO a -> IO ()
- Network.Socket.Internal: throwSocketErrorIfMinus1Retry :: Num a => String -> IO a -> IO a
+ Network.Socket.Internal: throwSocketErrorIfMinus1Retry :: (Num a) => String -> IO a -> IO a
- Network.Socket.Internal: throwSocketErrorIfMinus1RetryMayBlock :: Num a => String -> IO b -> IO a -> IO a
+ Network.Socket.Internal: throwSocketErrorIfMinus1RetryMayBlock :: (Num a) => String -> IO b -> IO a -> IO a
- Network.Socket.Internal: throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO ()
+ Network.Socket.Internal: throwSocketErrorIfMinus1_ :: (Num a) => String -> IO a -> IO ()
Files
- LICENSE +5/−7
- Network/Socket.hsc +13/−17
- Network/Socket/ByteString.hsc +373/−0
- Network/Socket/ByteString/IOVec.hsc +28/−0
- Network/Socket/ByteString/Internal.hs +56/−0
- Network/Socket/ByteString/Lazy.hsc +153/−0
- Network/Socket/ByteString/MsgHdr.hsc +42/−0
- Network/Socket/Internal.hsc +0/−16
- README +4/−0
- Setup.hs +13/−2
- examples/EchoClient.hs +18/−0
- examples/EchoServer.hs +27/−0
- include/HsNet.h +16/−0
- network.cabal +44/−24
- tests/Simple.hs +141/−0
- tests/net001.hs +27/−0
- tests/net002.hs +133/−0
- tests/uri001.hs +1166/−0
LICENSE view
@@ -1,21 +1,19 @@-The Glasgow Haskell Compiler License--Copyright 2002, The University Court of the University of Glasgow. -All rights reserved.+Copyright (c) 2002-2010, The University Court of the University of Glasgow.+Copyright (c) 2007-2010, Johan Tibell Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.- + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.- + - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without-specific prior written permission. +specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
Network/Socket.hsc view
@@ -24,26 +24,9 @@ -- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. ##include "Typeable.h" -#if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)-#define WITH_WINSOCK 1-#endif--#if !defined(mingw32_HOST_OS) && !defined(_WIN32)-#define DOMAIN_SOCKET_SUPPORT 1-#endif--#if !defined(CALLCONV)-#ifdef WITH_WINSOCK-#define CALLCONV stdcall-#else-#define CALLCONV ccall-#endif-#endif- -- In order to process this file, you need to have CALLCONV defined. module Network.Socket (- -- * Types Socket(..), -- instance Eq, Show Family(..), @@ -104,6 +87,8 @@ socketToHandle, -- :: Socket -> IOMode -> IO Handle + -- ** Sending and receiving data+ -- $sendrecv sendTo, -- :: Socket -> String -> SockAddr -> IO Int sendBufTo, -- :: Socket -> Ptr a -> Int -> SockAddr -> IO Int @@ -640,6 +625,17 @@ foreign import ccall unsafe "free" c_free:: Ptr a -> IO () #endif++-----------------------------------------------------------------------------+-- ** Sending and reciving data++-- $sendrecv+--+-- Do not use the @send@ and @recv@ functions defined in this module+-- in new code, as they incorrectly represent binary data as a Unicode+-- string. As a result, these functions are inefficient and may lead+-- to bugs in the program. Instead use the @send@ and @recv@+-- functions defined in the 'Network.Socket.ByteString' module. ----------------------------------------------------------------------------- -- sendTo & recvFrom
+ Network/Socket/ByteString.hsc view
@@ -0,0 +1,373 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++#include "HsNet.h"++-- |+-- Module : Network.Socket.ByteString+-- Copyright : (c) Johan Tibell 2007-2010+-- License : BSD-style+--+-- Maintainer : johan.tibell@gmail.com+-- Stability : stable+-- Portability : portable+--+-- This module provides access to the BSD /socket/ interface. This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'. For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket.ByteString+--+module Network.Socket.ByteString+ ( -- * Send data to a socket+ send+ , sendAll+ , sendTo+ , sendAllTo++ -- ** Vectored I/O+ -- $vectored+ , sendMany+ , sendManyTo++ -- * Receive data from a socket+ , recv+ , recvFrom++ -- * Example+ -- $example+ ) where++import Control.Monad (liftM, when)+import Data.ByteString (ByteString)+import Data.ByteString.Internal (createAndTrim)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Word (Word8)+import Foreign.C.Types (CInt)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, castPtr)+import Network.Socket (SockAddr, Socket(..), sendBufTo, recvBufFrom)++import qualified Data.ByteString as B++import Network.Socket.ByteString.Internal++#if !defined(mingw32_HOST_OS)+import Control.Monad (zipWithM_)+import Foreign.C.Types (CChar, CSize)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (Storable(..))+import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock,+ withSockAddr)++import Network.Socket.ByteString.IOVec (IOVec(..))+import Network.Socket.ByteString.MsgHdr (MsgHdr(..))++# if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitRead, threadWaitWrite)+# endif+#else+# if defined(__GLASGOW_HASKELL__)+# if __GLASGOW_HASKELL__ >= 611+import GHC.IO.FD+# else+import GHC.Handle (readRawBufferPtr, writeRawBufferPtr)+# endif+# endif+#endif++#if !defined(mingw32_HOST_OS)+foreign import CALLCONV unsafe "send"+ c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt+foreign import CALLCONV unsafe "recv"+ c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt+#endif++-- ----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket. The socket must be connected to a+-- remote socket. Returns the number of bytes sent. Applications are+-- responsible for ensuring that all data has been sent.+send :: Socket -- ^ Connected socket+ -> ByteString -- ^ Data to send+ -> IO Int -- ^ Number of bytes sent+send (MkSocket s _ _ _ _) xs =+ unsafeUseAsCStringLen xs $ \(str, len) ->+ liftM fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+# if __GLASGOW_HASKELL__ >= 611+ writeRawBufferPtr "Network.Socket.ByteString.send"+ (FD s 1) (castPtr str) 0 (fromIntegral len)+# else+ writeRawBufferPtr "Network.Socket.ByteString.send"+ (fromIntegral s) True str 0 (fromIntegral len)+# endif+#else+# if !defined(__HUGS__)+ throwSocketErrorIfMinus1RetryMayBlock "send"+ (threadWaitWrite (fromIntegral s)) $+# endif+ c_send s str (fromIntegral len) 0+#endif++-- | Send data to the socket. The socket must be connected to a+-- remote socket. Unlike 'send', this function continues to send data+-- until either all data has been sent or an error occurs. On error,+-- an exception is raised, and there is no way to determine how much+-- data, if any, was successfully sent.+sendAll :: Socket -- ^ Connected socket+ -> ByteString -- ^ Data to send+ -> IO ()+sendAll sock bs = do+ sent <- send sock bs+ when (sent < B.length bs) $ sendAll sock (B.drop sent bs)++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+sendTo :: Socket -- ^ Socket+ -> ByteString -- ^ Data to send+ -> SockAddr -- ^ Recipient address+ -> IO Int -- ^ Number of bytes sent+sendTo sock xs addr =+ unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo sock str len addr++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state. Unlike+-- 'sendTo', this function continues to send data until either all+-- data has been sent or an error occurs. On error, an exception is+-- raised, and there is no way to determine how much data, if any, was+-- successfully sent.+sendAllTo :: Socket -- ^ Socket+ -> ByteString -- ^ Data to send+ -> SockAddr -- ^ Recipient address+ -> IO ()+sendAllTo sock xs addr = do+ sent <- sendTo sock xs addr+ when (sent < B.length xs) $ sendAllTo sock (B.drop sent xs) addr++-- ----------------------------------------------------------------------------+-- ** Vectored I/O++-- $vectored+--+-- Vectored I\/O, also known as scatter\/gather I\/O, allows multiple+-- data segments to be sent using a single system call, without first+-- concatenating the segments. For example, given a list of+-- @ByteString@s, @xs@,+--+-- > sendMany sock xs+--+-- is equivalent to+--+-- > sendAll sock (concat xs)+--+-- but potentially more efficient.+--+-- Vectored I\/O are often useful when implementing network protocols+-- that, for example, group data into segments consisting of one or+-- more fixed-length headers followed by a variable-length body.++-- | Send data to the socket. The socket must be in a connected+-- state. The data is sent as if the parts have been concatenated.+-- This function continues to send data until either all data has been+-- sent or an error occurs. On error, an exception is raised, and+-- there is no way to determine how much data, if any, was+-- successfully sent.+sendMany :: Socket -- ^ Connected socket+ -> [ByteString] -- ^ Data to send+ -> IO ()+#if !defined(mingw32_HOST_OS)+sendMany sock@(MkSocket fd _ _ _ _) cs = do+ sent <- sendManyInner+ when (sent < totalLength cs) $ sendMany sock (remainingChunks sent cs)+ where+ sendManyInner =+ liftM fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->+ throwSocketErrorIfMinus1RetryMayBlock "writev"+ (threadWaitWrite (fromIntegral fd)) $+ c_writev (fromIntegral fd) iovsPtr (fromIntegral iovsLen)+#else+sendMany sock = sendAll sock . B.concat+#endif++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state. The+-- data is sent as if the parts have been concatenated. This function+-- continues to send data until either all data has been sent or an+-- error occurs. On error, an exception is raised, and there is no+-- way to determine how much data, if any, was successfully sent.+sendManyTo :: Socket -- ^ Socket+ -> [ByteString] -- ^ Data to send+ -> SockAddr -- ^ Recipient address+ -> IO ()+#if !defined(mingw32_HOST_OS)+sendManyTo sock@(MkSocket fd _ _ _ _) cs addr = do+ sent <- liftM fromIntegral sendManyToInner+ when (sent < totalLength cs) $ sendManyTo sock (remainingChunks sent cs) addr+ where+ sendManyToInner =+ withSockAddr addr $ \addrPtr addrSize ->+ withIOVec cs $ \(iovsPtr, iovsLen) -> do+ let msgHdr = MsgHdr+ addrPtr (fromIntegral addrSize)+ iovsPtr (fromIntegral iovsLen)+ with msgHdr $ \msgHdrPtr ->+ throwSocketErrorIfMinus1RetryMayBlock "sendmsg"+ (threadWaitWrite (fromIntegral fd)) $+ c_sendmsg (fromIntegral fd) msgHdrPtr 0+#else+sendManyTo sock cs = sendAllTo sock (B.concat cs)+#endif++-- ----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket. The socket must be in a connected+-- state. This function may return fewer bytes than specified. If+-- the message is longer than the specified length, it may be+-- discarded depending on the type of socket. This function may block+-- until a message arrives.+--+-- Considering hardware and network realities, the maximum number of bytes to+-- receive should be a small power of 2, e.g., 4096.+--+-- For TCP sockets, a zero length return value means the peer has+-- closed its half side of the connection.+recv :: Socket -- ^ Connected socket+ -> Int -- ^ Maximum number of bytes to receive+ -> IO ByteString -- ^ Data received+recv (MkSocket s _ _ _ _) nbytes+ | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")+ | otherwise = createAndTrim nbytes $ recvInner s nbytes++recvInner :: CInt -> Int -> Ptr Word8 -> IO Int+recvInner s nbytes ptr =+ fmap fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+# if __GLASGOW_HASKELL__ >= 611+ readRawBufferPtr "Network.Socket.ByteString.recv" (FD s 1) ptr 0 (fromIntegral nbytes)+# else+ readRawBufferPtr "Network.Socket.ByteString.recv" (fromIntegral s)+ True (castPtr ptr) 0 (fromIntegral nbytes)+# endif+#else+# if !defined(__HUGS__)+ throwSocketErrorIfMinus1RetryMayBlock "recv"+ (threadWaitRead (fromIntegral s)) $+# endif+ c_recv s (castPtr ptr) (fromIntegral nbytes) 0+#endif++-- | Receive data from the socket. The socket need not be in a+-- connected state. Returns @(bytes, address)@ where @bytes@ is a+-- 'ByteString' representing the data received and @address@ is a+-- 'SockAddr' representing the address of the sending socket.+recvFrom :: Socket -- ^ Socket+ -> Int -- ^ Maximum number of bytes to receive+ -> IO (ByteString, SockAddr) -- ^ Data received and sender address+recvFrom sock nbytes =+ allocaBytes nbytes $ \ptr -> do+ (len, sockaddr) <- recvBufFrom sock ptr nbytes+ str <- B.packCStringLen (ptr, len)+ return (str, sockaddr)++-- ----------------------------------------------------------------------------+-- Not exported++#if !defined(mingw32_HOST_OS)+-- | Suppose we try to transmit a list of chunks @cs@ via a gathering write+-- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is+-- list of chunks remaining to be sent.+remainingChunks :: Int -> [ByteString] -> [ByteString]+remainingChunks _ [] = []+remainingChunks i (x:xs)+ | i < len = B.drop i x : xs+ | otherwise = let i' = i - len in i' `seq` remainingChunks i' xs+ where+ len = B.length x++-- | @totalLength cs@ is the sum of the lengths of the chunks in the list @cs@.+totalLength :: [ByteString] -> Int+totalLength = sum . map B.length++-- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair+-- consisting of a pointer to a temporarily allocated array of pointers to+-- 'IOVec' made from @cs@ and the number of pointers (@length cs@).+-- /Unix only/.+withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a+withIOVec cs f =+ allocaArray csLen $ \aPtr -> do+ zipWithM_ pokeIov (ptrs aPtr) cs+ f (aPtr, csLen)+ where+ csLen = length cs+ ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))+ pokeIov ptr s =+ unsafeUseAsCStringLen s $ \(sPtr, sLen) ->+ poke ptr $ IOVec sPtr (fromIntegral sLen)+#endif++-- ---------------------------------------------------------------------+-- Example++-- $example+--+-- Here are two minimal example programs using the TCP/IP protocol: a+-- server that echoes all data that it receives back (servicing only+-- one client) and a client using it.+--+-- > -- Echo server program+-- > module Main where+-- >+-- > import Control.Monad (unless)+-- > import Network.Socket hiding (recv)+-- > import qualified Data.ByteString as S+-- > import Network.Socket.ByteString (recv, sendAll)+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- > do addrinfos <- getAddrInfo+-- > (Just (defaultHints {addrFlags = [AI_PASSIVE]}))+-- > Nothing (Just "3000")+-- > let serveraddr = head addrinfos+-- > sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- > bindSocket sock (addrAddress serveraddr)+-- > listen sock 1+-- > (conn, _) <- accept sock+-- > talk conn+-- > sClose conn+-- > sClose sock+-- >+-- > where+-- > talk :: Socket -> IO ()+-- > talk conn =+-- > do msg <- recv conn 1024+-- > unless (S.null msg) $ sendAll conn msg >> talk conn+--+-- > -- Echo client program+-- > module Main where+-- >+-- > import Network.Socket hiding (recv)+-- > import Network.Socket.ByteString (recv, sendAll)+-- > import qualified Data.ByteString.Char8 as C+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- > do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+-- > let serveraddr = head addrinfos+-- > sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- > connect sock (addrAddress serveraddr)+-- > sendAll sock $ C.pack "Hello, world!"+-- > msg <- recv sock 1024+-- > sClose sock+-- > putStr "Received "+-- > C.putStrLn msg
+ Network/Socket/ByteString/IOVec.hsc view
@@ -0,0 +1,28 @@+-- | Support module for the POSIX writev system call.+module Network.Socket.ByteString.IOVec+ ( IOVec(..)+ ) where++import Foreign.C.Types (CChar, CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))++#include <sys/uio.h>++data IOVec = IOVec+ { iovBase :: Ptr CChar+ , iovLen :: CSize+ }++instance Storable IOVec where+ sizeOf _ = (#const sizeof(struct iovec))+ alignment _ = alignment (undefined :: CInt)++ peek p = do+ base <- (#peek struct iovec, iov_base) p+ len <- (#peek struct iovec, iov_len) p+ return $ IOVec base len++ poke p iov = do+ (#poke struct iovec, iov_base) p (iovBase iov)+ (#poke struct iovec, iov_len) p (iovLen iov)
+ Network/Socket/ByteString/Internal.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++-- |+-- Module : Network.Socket.ByteString.Internal+-- Copyright : (c) Johan Tibell 2007-2010+-- License : BSD-style+--+-- Maintainer : johan.tibell@gmail.com+-- Stability : stable+-- Portability : portable+--+module Network.Socket.ByteString.Internal+ ( mkInvalidRecvArgError+#if !defined(mingw32_HOST_OS)+ , c_writev+ , c_sendmsg+#endif+ ) where++import System.IO.Error (ioeSetErrorString, mkIOError)++#if !defined(mingw32_HOST_OS)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr)+import System.Posix.Types (CSsize)++import Network.Socket.ByteString.IOVec (IOVec)+import Network.Socket.ByteString.MsgHdr (MsgHdr)+#endif++#ifdef __GLASGOW_HASKELL__+# if __GLASGOW_HASKELL__ < 611+import GHC.IOBase (IOErrorType(..))+# else+import GHC.IO.Exception (IOErrorType(..))+# endif+#elif __HUGS__+import Hugs.Prelude (IOErrorType(..))+#endif++mkInvalidRecvArgError :: String -> IOError+mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError+#ifdef __GLASGOW_HASKELL__+ InvalidArgument+#else+ IllegalOperation+#endif+ loc Nothing Nothing) "non-positive length"++#if !defined(mingw32_HOST_OS)+foreign import ccall unsafe "writev"+ c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize++foreign import ccall unsafe "sendmsg"+ c_sendmsg :: CInt -> Ptr MsgHdr -> CInt -> IO CSsize+#endif
+ Network/Socket/ByteString/Lazy.hsc view
@@ -0,0 +1,153 @@+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface #-}++-- |+-- Module : Network.Socket.ByteString.Lazy+-- Copyright : (c) Bryan O'Sullivan 2009+-- License : BSD-style+--+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : POSIX, GHC+--+-- This module provides access to the BSD /socket/ interface. This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'. For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket.ByteString.Lazy+-- > import Prelude hiding (getContents)+--+module Network.Socket.ByteString.Lazy+ (+#if !defined(mingw32_HOST_OS)+ -- * Send data to a socket+ send,+ sendAll,+#endif++ -- * Receive data from a socket+ getContents,+ recv+ ) where++import Control.Monad (liftM)+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)+import Data.Int (Int64)+import Network.Socket (Socket(..), ShutdownCmd(..), shutdown)+import Prelude hiding (getContents)+import System.IO.Unsafe (unsafeInterleaveIO)++import qualified Data.ByteString as S+import qualified Network.Socket.ByteString as N++#if !defined(mingw32_HOST_OS)+import Control.Monad (unless)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (Storable(..))+import Network.Socket.ByteString.IOVec (IOVec(IOVec))+import Network.Socket.ByteString.Internal (c_writev)+import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock)++import qualified Data.ByteString.Lazy as L++# if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitWrite)+# endif+#endif++#if !defined(mingw32_HOST_OS)+-- -----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket. The socket must be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+--+-- Because a lazily generated 'ByteString' may be arbitrarily long,+-- this function caps the amount it will attempt to send at 4MB. This+-- number is large (so it should not penalize performance on fast+-- networks), but not outrageously so (to avoid demanding lazily+-- computed data unnecessarily early). Before being sent, the lazy+-- 'ByteString' will be converted to a list of strict 'ByteString's+-- with 'L.toChunks'; at most 1024 chunks will be sent. /Unix only/.+send :: Socket -- ^ Connected socket+ -> ByteString -- ^ Data to send+ -> IO Int64 -- ^ Number of bytes sent+send (MkSocket fd _ _ _ _) s = do+ let cs = take maxNumChunks (L.toChunks s)+ len = length cs+ liftM fromIntegral . allocaArray len $ \ptr ->+ withPokes cs ptr $ \niovs ->+# if !defined(__HUGS__)+ throwSocketErrorIfMinus1RetryMayBlock "writev"+ (threadWaitWrite (fromIntegral fd)) $+# endif+ c_writev (fromIntegral fd) ptr niovs+ where+ withPokes ss p f = loop ss p 0 0+ where loop (c:cs) q k !niovs+ | k < maxNumBytes =+ unsafeUseAsCStringLen c $ \(ptr,len) -> do+ poke q $ IOVec ptr (fromIntegral len)+ loop cs (q `plusPtr` sizeOf (undefined :: IOVec))+ (k + fromIntegral len) (niovs + 1)+ | otherwise = f niovs+ loop _ _ _ niovs = f niovs+ maxNumBytes = 4194304 :: Int -- maximum number of bytes to transmit in one system call+ maxNumChunks = 1024 :: Int -- maximum number of chunks to transmit in one system call++-- | Send data to the socket. The socket must be in a connected+-- state. This function continues to send data until either all data+-- has been sent or an error occurs. If there is an error, an+-- exception is raised, and there is no way to determine how much data+-- was sent. /Unix only/.+sendAll :: Socket -- ^ Connected socket+ -> ByteString -- ^ Data to send+ -> IO ()+sendAll sock bs = do+ sent <- send sock bs+ let bs' = L.drop sent bs+ unless (L.null bs') $ sendAll sock bs'+#endif++-- -----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket. The socket must be in a connected+-- state. Data is received on demand, in chunks; each chunk will be+-- sized to reflect the amount of data received by individual 'recv'+-- calls.+--+-- All remaining data from the socket is consumed. When there is no+-- more data to be received, the receiving side of the socket is shut+-- down. If there is an error and an exception is thrown, the socket+-- is not shut down.+getContents :: Socket -- ^ Connected socket+ -> IO ByteString -- ^ Data received+getContents sock = loop where+ loop = unsafeInterleaveIO $ do+ s <- N.recv sock defaultChunkSize+ if S.null s+ then shutdown sock ShutdownReceive >> return Empty+ else Chunk s `liftM` loop++-- | Receive data from the socket. The socket must be in a connected+-- state. This function may return fewer bytes than specified. If+-- the received data is longer than the specified length, it may be+-- discarded depending on the type of socket. This function may block+-- until a message arrives.+--+-- If there is no more data to be received, returns an empty 'ByteString'.+recv :: Socket -- ^ Connected socket+ -> Int64 -- ^ Maximum number of bytes to receive+ -> IO ByteString -- ^ Data received+recv sock nbytes = chunk `liftM` N.recv sock (fromIntegral nbytes) where+ chunk k+ | S.null k = Empty+ | otherwise = Chunk k Empty
+ Network/Socket/ByteString/MsgHdr.hsc view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}++-- | Support module for the POSIX 'sendmsg' system call.+module Network.Socket.ByteString.MsgHdr+ ( MsgHdr(..)+ ) where++#include <sys/types.h>+#include <sys/socket.h>++import Foreign.C.Types (CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))+import Network.Socket (SockAddr)++import Network.Socket.ByteString.IOVec (IOVec)++-- We don't use msg_control, msg_controllen, and msg_flags as these+-- don't exist on OpenSolaris.+data MsgHdr = MsgHdr+ { msgName :: Ptr SockAddr+ , msgNameLen :: CSize+ , msgIov :: Ptr IOVec+ , msgIovLen :: CSize+ }++instance Storable MsgHdr where+ sizeOf _ = (#const sizeof(struct msghdr))+ alignment _ = alignment (undefined :: CInt)++ peek p = do+ name <- (#peek struct msghdr, msg_name) p+ nameLen <- (#peek struct msghdr, msg_namelen) p+ iov <- (#peek struct msghdr, msg_iov) p+ iovLen <- (#peek struct msghdr, msg_iovlen) p+ return $ MsgHdr name nameLen iov iovLen++ poke p mh = do+ (#poke struct msghdr, msg_name) p (msgName mh)+ (#poke struct msghdr, msg_namelen) p (msgNameLen mh)+ (#poke struct msghdr, msg_iov) p (msgIov mh)+ (#poke struct msghdr, msg_iovlen) p (msgIovLen mh)
Network/Socket/Internal.hsc view
@@ -18,22 +18,6 @@ #include "HsNet.h" -#if defined(HAVE_WINSOCK2_H) && !defined(cygwin32_HOST_OS)-#define WITH_WINSOCK 1-#endif--#if !defined(mingw32_HOST_OS) && !defined(_WIN32)-#define DOMAIN_SOCKET_SUPPORT 1-#endif--#if !defined(CALLCONV)-#ifdef WITH_WINSOCK-#define CALLCONV stdcall-#else-#define CALLCONV ccall-#endif-#endif- module Network.Socket.Internal ( -- * Socket addresses
+ README view
@@ -0,0 +1,4 @@+To build this package using Cabal directly from git, you must run+"autoreconf" before the usual Cabal build steps (configure/build/install).+autoreconf is included in the GNU autoconf tools. There is no need to run+the "configure" script: the "setup configure" step will do this for you.
Setup.hs view
@@ -1,6 +1,17 @@ module Main (main) where -import Distribution.Simple+import Control.Monad (unless)+import Distribution.Simple (defaultMainWithHooks, runTests, simpleUserHooks)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))+import Distribution.Simple.Utils (die)+import System.Cmd (system)+import System.Directory (doesDirectoryExist) main :: IO ()-main = defaultMainWithHooks defaultUserHooks+main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests' }+ where+ runTests' _ _ _ lbi = do+ built <- doesDirectoryExist $ buildDir lbi+ unless built $ die "Run the 'build' command first."+ system "runhaskell -i./dist/build tests/Simple.hs"+ return ()
+ examples/EchoClient.hs view
@@ -0,0 +1,18 @@+-- Echo client program+module Main where++import Network.Socket hiding (recv)+import Network.Socket.ByteString (recv, sendAll)+import qualified Data.ByteString.Char8 as C++main :: IO ()+main = withSocketsDo $+ do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+ let serveraddr = head addrinfos+ sock <- socket (addrFamily serveraddr) Stream defaultProtocol+ connect sock (addrAddress serveraddr)+ sendAll sock $ C.pack "Hello, world!"+ msg <- recv sock 1024+ sClose sock+ putStr "Received "+ C.putStrLn msg
+ examples/EchoServer.hs view
@@ -0,0 +1,27 @@+-- Echo server program+module Main where++import Control.Monad (unless)+import Network.Socket hiding (recv)+import qualified Data.ByteString as S+import Network.Socket.ByteString (recv, sendAll)++main :: IO ()+main = withSocketsDo $+ do addrinfos <- getAddrInfo+ (Just (defaultHints {addrFlags = [AI_PASSIVE]}))+ Nothing (Just "3000")+ let serveraddr = head addrinfos+ sock <- socket (addrFamily serveraddr) Stream defaultProtocol+ bindSocket sock (addrAddress serveraddr)+ listen sock 1+ (conn, _) <- accept sock+ talk conn+ sClose conn+ sClose sock++ where+ talk :: Socket -> IO ()+ talk conn =+ do msg <- recv conn 1024+ unless (S.null msg) $ sendAll conn msg >> talk conn
include/HsNet.h view
@@ -174,4 +174,20 @@ } #endif +#if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)+# define WITH_WINSOCK 1 #endif++#if !defined(mingw32_HOST_OS) && !defined(_WIN32)+# define DOMAIN_SOCKET_SUPPORT 1+#endif++#if !defined(CALLCONV)+# if defined(WITH_WINSOCK)+# define CALLCONV stdcall+# else+# define CALLCONV ccall+# endif+#endif++#endif /* HSNET_H */
network.cabal view
@@ -1,46 +1,66 @@ name: network-version: 2.2.1.10+version: 2.2.3 license: BSD3 license-file: LICENSE maintainer: Johan Tibell <johan.tibell@gmail.com>-synopsis: Networking-related facilities+synopsis: Low-level networking interface+description: Low-level networking interface category: Network build-type: Configure cabal-version: >=1.6 extra-tmp-files:- config.log config.status autom4te.cache- network.buildinfo include/HsNetworkConfig.h+ config.log config.status autom4te.cache network.buildinfo+ include/HsNetworkConfig.h extra-source-files:- config.guess config.sub install-sh- configure.ac configure- network.buildinfo.in include/HsNetworkConfig.h.in- include/HsNet.h include/Typeable.h- -- C sources only used on some systems- cbits/ancilData.c- cbits/asyncAccept.c cbits/initWinSock.c cbits/winSockErr.c+ README examples/*.hs tests/*.hs config.guess config.sub install-sh+ configure.ac configure network.buildinfo.in+ include/HsNetworkConfig.h.in include/HsNet.h include/Typeable.h+ -- C sources only used on some systems+ cbits/ancilData.c cbits/asyncAccept.c cbits/initWinSock.c+ cbits/winSockErr.c+homepage: http://github.com/haskell/network bug-reports: http://trac.haskell.org/network/ flag base4 library exposed-modules:- Network Network.BSD Network.Socket.Internal Network.Socket- Network.URI- build-depends: base < 5, parsec+ Network+ Network.BSD+ Network.Socket+ Network.Socket.ByteString+ Network.Socket.ByteString.Lazy+ Network.Socket.Internal+ Network.URI+ other-modules:+ Network.Socket.ByteString.Internal + if !os(windows)+ other-modules:+ Network.Socket.ByteString.IOVec+ Network.Socket.ByteString.MsgHdr++ build-depends:+ base < 5,+ bytestring < 1.0,+ parsec++ if !os(windows)+ build-depends:+ unix >= 2 && < 3+ if flag(base4)- build-depends: base >= 4 && < 4.4- cpp-options: -DBASE4+ build-depends: base >= 4 && < 4.4+ cpp-options: -DBASE4 else- build-depends: base<4+ build-depends: base<4 - extensions: CPP, DeriveDataTypeable, ForeignFunctionInterface,- TypeSynonymInstances- include-dirs: include- includes: HsNet.h- install-includes:- HsNet.h HsNetworkConfig.h- c-sources: cbits/HsNet.c+ extensions:+ CPP, DeriveDataTypeable, ForeignFunctionInterface, TypeSynonymInstances+ include-dirs: include+ includes: HsNet.h+ install-includes: HsNet.h HsNetworkConfig.h+ c-sources: cbits/HsNet.c source-repository head type: git
+ tests/Simple.hs view
@@ -0,0 +1,141 @@+module Main where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Exception (bracket)+import Control.Monad (when)+import Network.Socket hiding (recv, recvFrom, send)+import System.Exit (exitFailure)+import Test.HUnit (Counts(..), Test(..), (@=?), runTestTT)++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy.Char8 as L++import Network.Socket.ByteString (recv, recvFrom, send, sendAll, sendMany)+import qualified Network.Socket.ByteString.Lazy as NSBL++------------------------------------------------------------------------++port :: PortNumber+port = fromIntegral (3000 :: Int)++testMsg :: S.ByteString+testMsg = C.pack "This is a test message."++testLazySend :: Test+testLazySend = TestCase $ connectedTest client server+ where+ server sock = recv sock 1024 >>= (@=?) (C.take 1024 strictTestMsg)+ client sock = NSBL.send sock lazyTestMsg >>= (@=?) 1024++ -- message containing too many chunks to be sent in one system call+ lazyTestMsg = let alphabet = map C.singleton ['a'..'z']+ in L.fromChunks (concat (replicate 100 alphabet))++ strictTestMsg = C.concat . L.toChunks $ lazyTestMsg++------------------------------------------------------------------------+-- Tests++testSendAll :: Test+testSendAll = TestCase $ connectedTest client server+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock = sendAll sock testMsg++testSendMany :: Test+testSendMany = TestCase $ connectedTest client server+ 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."++testRecv :: Test+testRecv = TestCase $ connectedTest client server+ where+ server sock = recv sock 1024 >>= (@=?) testMsg+ client sock = send sock testMsg++testOverFlowRecv :: Test+testOverFlowRecv = TestCase $ connectedTest 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++ client sock = send sock testMsg++testRecvFrom :: Test+testRecvFrom = TestCase $ connectedTest client server+ where+ server sock = do (msg, _) <- recvFrom sock 1024+ testMsg @=? msg++ client sock = send sock testMsg++testOverFlowRecvFrom :: Test+testOverFlowRecvFrom = TestCase $ connectedTest 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++ client sock = send sock testMsg++------------------------------------------------------------------------+-- Test helpers++-- | Run a client/server pair and synchronize them so that the server+-- is started before the client and the specified server action is+-- finished before the client closes the connection.+connectedTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()+connectedTest clientAct serverAct = do+ barrier <- newEmptyMVar+ forkIO $ server barrier+ client barrier+ where+ server barrier = do+ addr <- inet_addr "127.0.0.1"+ bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+ setSocketOption sock ReuseAddr 1+ bindSocket sock (SockAddrInet port addr)+ listen sock 1+ serverReady+ (clientSock, _) <- accept sock+ serverAct clientSock+ sClose clientSock+ putMVar barrier ()+ where+ -- | Signal to the client that it can proceed.+ serverReady = putMVar barrier ()++ client barrier = do+ takeMVar barrier+ bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+ addr <- inet_addr "127.0.0.1"+ connect sock $ SockAddrInet port addr+ clientAct sock+ takeMVar barrier++------------------------------------------------------------------------+-- Test harness++main :: IO ()+main = withSocketsDo $ do+ counts <- runTestTT tests+ when (errors counts + failures counts > 0) exitFailure++tests :: Test+tests = TestList [ TestLabel "testLazySend" testLazySend+ , TestLabel "testSendAll" testSendMany+ , TestLabel "testSendMany" testSendMany+ , TestLabel "testRecv" testRecv+ , TestLabel "testOverFlowRecv" testOverFlowRecv+ , TestLabel "testRecvFrom" testRecvFrom+ , TestLabel "testOverFlowRecvFrom" testOverFlowRecvFrom+ ]
+ tests/net001.hs view
@@ -0,0 +1,27 @@+module Main where++import Network+import Control.Concurrent+import System.IO++-- NOTE: this test depends on non-blocking I/O support,+-- which win32 doesn't support. Rather than having the+-- test program block, we fail to initialise WinSock+-- (via withSocketsDo) here so that the test will fall over+-- (and repeatedly remind us to implement Win32 support+-- for non-blocking I/O !)++main = {- withSocketsDo $ -} do+ forkIO server+ threadDelay 1000000+ h <- connectTo "localhost" (PortNumber 22222)+ l <- hGetLine h+ hClose h+ print l+ where+ server = do+ s <- listenOn (PortNumber 22222)+ (h, host, port) <- accept s+ hPutStrLn h "hello"+ hClose h+
+ tests/net002.hs view
@@ -0,0 +1,133 @@+-- $Id: net002.hs,v 1.5 2005/01/17 09:57:24 simonmar Exp $+-- http://www.bagley.org/~doug/shootout/+-- Haskell echo/client server+-- written by Brian Gregor+-- compile with:+-- ghc -O -o echo -package net -package concurrent -package lang echo.hs+ +-- !!! exposed a bug in 5.02.2's network library, accept wasn't setting the+-- socket it returned to non-blocking mode.++-- NOTE: this test depends on non-blocking I/O support,+-- which win32 doesn't support. Rather than having the+-- test program block, we fail to initialise WinSock+-- (via withSocketsDo) here so that the test will fall over+-- (and repeatedly remind us to implement Win32 support+-- for non-blocking I/O !)++module Main where++import Network.Socket++import Prelude hiding (putStr)+import System.IO hiding (putStr)+import qualified System.IO+import System.IO.Error+import Control.Concurrent+import System.Environment ( getArgs )+import System.Exit ( exitFailure )+import Control.Exception ( finally )++server_sock :: IO (Socket)+server_sock = do+ s <- socket AF_INET Stream 6+ setSocketOption s ReuseAddr 1+ -- bindSocket s (SockAddrInet (mkPortNumber portnum) iNADDR_ANY)+ bindSocket s (SockAddrInet (PortNum portnum) iNADDR_ANY)+ listen s 2+ return s++eofAsEmptyHandler :: IOError -> IO String+eofAsEmptyHandler e+ | isEOFError e = return ""+ | otherwise = ioError e++-- For debugging, enable the putStr below. Turn it off to get deterministic+-- results: on a multiprocessor we can't predict the order of the messages.+putStr = const (return ())+-- putStr = System.IO.putStr ++echo_server s = do+ (s', clientAddr) <- accept s+ proc <- read_data s' 0+ putStrLn ("server processed "++(show proc)++" bytes")+ sClose s'+ where+ read_data sock totalbytes = do+ -- (str,i) <- readSocket sock 19+ str <- recv sock 19 `catch` eofAsEmptyHandler+ -- if (i >= 19) + putStr ("Server recv: " ++ str)+ if ((length str) >= 19) + then do+ putStr ("Server read: " ++ str)+ -- writ <- writeSocket sock str+ writ <- send sock str+ putStr ("Server wrote: " ++ str)+ --+ read_data sock $! (totalbytes+(length $! str))+ -- read_data sock (totalbytes+(length str))+ else do+ putStr ("server read: " ++ str)+ return totalbytes++local = "127.0.0.1" +message = "Hello there sailor\n"+portnum = 7001++client_sock = do+ s <- socket AF_INET Stream 6+ ia <- inet_addr local+ -- connect s (SockAddrInet (mkPortNumber portnum) ia)+ connect s (SockAddrInet (PortNum portnum) ia)+ return s++echo_client n = do+ s <- client_sock+ drop <- server_echo s n+ sClose s+ where+ server_echo sock n = if n > 0+ then do + -- writeSocket sock message+ send sock message+ putStr ("Client wrote: " ++ message)+ --+ -- (str,i) <- readSocket sock 19+ str <- recv sock 19 `catch` eofAsEmptyHandler+ if (str /= message)+ then do+ putStr ("Client read error: " ++ str ++ "\n")+ exitFailure+ else do+ putStr ("Client read success")+ server_echo sock (n-1)+ else do + putStr "Client read nil\n"+ return []++main = {- withSocketsDo $ -} do + ~[n] <- getArgs+ -- server & client semaphores+ -- get the server socket+ ssock <- server_sock + -- fork off the server+ s <- myForkIO (echo_server ssock)+ -- fork off the client+ c <- myForkIO (echo_client (read n::Int))+ -- let 'em run until they've signaled they're done+ join s+ System.IO.putStr "join s\n"+ join c+ System.IO.putStr "join c\n"++-- these are used to make the main thread wait until+-- the child threads have exited+myForkIO :: IO () -> IO (MVar ())+myForkIO io = do+ mvar <- newEmptyMVar+ forkIO (io `finally` putMVar mvar ())+ return mvar++join :: MVar () -> IO ()+join mvar = readMVar mvar
+ tests/uri001.hs view
@@ -0,0 +1,1166 @@+--------------------------------------------------------------------------------+-- $Id: URITest.hs,v 1.8 2005/07/19 22:01:27 gklyne Exp $+--+-- Copyright (c) 2004, G. KLYNE. All rights reserved.+-- See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+-- Module : URITest+-- Copyright : (c) 2004, Graham Klyne+-- License : BSD-style (see end of this file)+--+-- Maintainer : Graham Klyne+-- Stability : provisional+-- Portability : H98+--+-- This Module contains test cases for module URI.+--+-- Using GHC, I compile with this command line:+-- ghc --make -fglasgow-exts+-- -i..\;C:\Dev\Haskell\Lib\HUnit;C:\Dev\Haskell\Lib\Parsec+-- -o URITest.exe URITest -main-is URITest.main+-- The -i line may need changing for alternative installations.+--+--------------------------------------------------------------------------------++module Main where++import Network.URI+ ( URI(..), URIAuth(..)+ , nullURI+ , parseURI, parseURIReference, parseRelativeReference, parseAbsoluteURI+ , parseabsoluteURI+ , isURI, isURIReference, isRelativeReference, isAbsoluteURI+ , isIPv6address, isIPv4address+ , relativeTo, nonStrictRelativeTo+ , relativeFrom+ , uriToString+ , isUnescapedInURI, escapeURIString, unEscapeString+ , normalizeCase, normalizeEscape, normalizePathSegments+ )++import Test.HUnit++import IO ( Handle, openFile, IOMode(WriteMode), hClose, hPutStr, hPutStrLn )++import Maybe ( fromJust )++-- Test supplied string for valid URI reference syntax+-- isValidURIRef :: String -> Bool+-- Test supplied string for valid absolute URI reference syntax+-- isAbsoluteURIRef :: String -> Bool+-- Test supplied string for valid absolute URI syntax+-- isAbsoluteURI :: String -> Bool++data URIType = AbsId -- URI form (absolute, no fragment)+ | AbsRf -- Absolute URI reference+ | RelRf -- Relative URI reference+ | InvRf -- Invalid URI reference+isValidT :: URIType -> Bool+isValidT InvRf = False+isValidT _ = True++isAbsRfT :: URIType -> Bool+isAbsRfT AbsId = True+isAbsRfT AbsRf = True+isAbsRfT _ = False++isRelRfT :: URIType -> Bool+isRelRfT RelRf = True+isRelRfT _ = False++isAbsIdT :: URIType -> Bool+isAbsIdT AbsId = True+isAbsIdT _ = False++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab a1 a2 = TestCase ( assertEqual lab a1 a2 )++testURIRef :: URIType -> String -> Test+testURIRef t u = TestList+ [ testEq ("test_isURIReference:"++u) (isValidT t) (isURIReference u)+ , testEq ("test_isRelativeReference:"++u) (isRelRfT t) (isRelativeReference u)+ , testEq ("test_isAbsoluteURI:"++u) (isAbsIdT t) (isAbsoluteURI u)+ ]++testURIRefComponents :: String -> (Maybe URI) -> String -> Test+testURIRefComponents lab uv us =+ testEq ("testURIRefComponents:"++us) uv (parseURIReference us)+++testURIRef001 = testURIRef AbsRf "http://example.org/aaa/bbb#ccc"+testURIRef002 = testURIRef AbsId "mailto:local@domain.org"+testURIRef003 = testURIRef AbsRf "mailto:local@domain.org#frag"+testURIRef004 = testURIRef AbsRf "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"+testURIRef005 = testURIRef RelRf "//example.org/aaa/bbb#ccc"+testURIRef006 = testURIRef RelRf "/aaa/bbb#ccc"+testURIRef007 = testURIRef RelRf "bbb#ccc"+testURIRef008 = testURIRef RelRf "#ccc"+testURIRef009 = testURIRef RelRf "#"+testURIRef010 = testURIRef RelRf "/"+-- escapes+testURIRef011 = testURIRef AbsRf "http://example.org/aaa%2fbbb#ccc"+testURIRef012 = testURIRef AbsRf "http://example.org/aaa%2Fbbb#ccc"+testURIRef013 = testURIRef RelRf "%2F"+testURIRef014 = testURIRef RelRf "aaa%2Fbbb"+-- ports+testURIRef015 = testURIRef AbsRf "http://example.org:80/aaa/bbb#ccc"+testURIRef016 = testURIRef AbsRf "http://example.org:/aaa/bbb#ccc"+testURIRef017 = testURIRef AbsRf "http://example.org./aaa/bbb#ccc"+testURIRef018 = testURIRef AbsRf "http://example.123./aaa/bbb#ccc"+-- bare authority+testURIRef019 = testURIRef AbsId "http://example.org"+-- IPv6 literals (from RFC2732):+testURIRef021 = testURIRef AbsId "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html"+testURIRef022 = testURIRef AbsId "http://[1080:0:0:0:8:800:200C:417A]/index.html"+testURIRef023 = testURIRef AbsId "http://[3ffe:2a00:100:7031::1]"+testURIRef024 = testURIRef AbsId "http://[1080::8:800:200C:417A]/foo"+testURIRef025 = testURIRef AbsId "http://[::192.9.5.5]/ipng"+testURIRef026 = testURIRef AbsId "http://[::FFFF:129.144.52.38]:80/index.html"+testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]"+testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]"+testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]"+-- RFC2396 test cases+testURIRef031 = testURIRef RelRf "./aaa"+testURIRef032 = testURIRef RelRf "../aaa"+testURIRef033 = testURIRef AbsId "g:h"+testURIRef034 = testURIRef RelRf "g"+testURIRef035 = testURIRef RelRf "./g"+testURIRef036 = testURIRef RelRf "g/"+testURIRef037 = testURIRef RelRf "/g"+testURIRef038 = testURIRef RelRf "//g"+testURIRef039 = testURIRef RelRf "?y"+testURIRef040 = testURIRef RelRf "g?y"+testURIRef041 = testURIRef RelRf "#s"+testURIRef042 = testURIRef RelRf "g#s"+testURIRef043 = testURIRef RelRf "g?y#s"+testURIRef044 = testURIRef RelRf ";x"+testURIRef045 = testURIRef RelRf "g;x"+testURIRef046 = testURIRef RelRf "g;x?y#s"+testURIRef047 = testURIRef RelRf "."+testURIRef048 = testURIRef RelRf "./"+testURIRef049 = testURIRef RelRf ".."+testURIRef050 = testURIRef RelRf "../"+testURIRef051 = testURIRef RelRf "../g"+testURIRef052 = testURIRef RelRf "../.."+testURIRef053 = testURIRef RelRf "../../"+testURIRef054 = testURIRef RelRf "../../g"+testURIRef055 = testURIRef RelRf "../../../g"+testURIRef056 = testURIRef RelRf "../../../../g"+testURIRef057 = testURIRef RelRf "/./g"+testURIRef058 = testURIRef RelRf "/../g"+testURIRef059 = testURIRef RelRf "g."+testURIRef060 = testURIRef RelRf ".g"+testURIRef061 = testURIRef RelRf "g.."+testURIRef062 = testURIRef RelRf "..g"+testURIRef063 = testURIRef RelRf "./../g"+testURIRef064 = testURIRef RelRf "./g/."+testURIRef065 = testURIRef RelRf "g/./h"+testURIRef066 = testURIRef RelRf "g/../h"+testURIRef067 = testURIRef RelRf "g;x=1/./y"+testURIRef068 = testURIRef RelRf "g;x=1/../y"+testURIRef069 = testURIRef RelRf "g?y/./x"+testURIRef070 = testURIRef RelRf "g?y/../x"+testURIRef071 = testURIRef RelRf "g#s/./x"+testURIRef072 = testURIRef RelRf "g#s/../x"+testURIRef073 = testURIRef RelRf ""+testURIRef074 = testURIRef RelRf "A'C"+testURIRef075 = testURIRef RelRf "A$C"+testURIRef076 = testURIRef RelRf "A@C"+testURIRef077 = testURIRef RelRf "A,C"+-- Invalid+testURIRef080 = testURIRef InvRf "http://foo.org:80Path/More"+testURIRef081 = testURIRef InvRf "::"+testURIRef082 = testURIRef InvRf " "+testURIRef083 = testURIRef InvRf "%"+testURIRef084 = testURIRef InvRf "A%Z"+testURIRef085 = testURIRef InvRf "%ZZ"+testURIRef086 = testURIRef InvRf "%AZ"+testURIRef087 = testURIRef InvRf "A C"+-- testURIRef088 = -- (case removed)+-- testURIRef089 = -- (case removed)+testURIRef090 = testURIRef InvRf "A\"C"+testURIRef091 = testURIRef InvRf "A`C"+testURIRef092 = testURIRef InvRf "A<C"+testURIRef093 = testURIRef InvRf "A>C"+testURIRef094 = testURIRef InvRf "A^C"+testURIRef095 = testURIRef InvRf "A\\C"+testURIRef096 = testURIRef InvRf "A{C"+testURIRef097 = testURIRef InvRf "A|C"+testURIRef098 = testURIRef InvRf "A}C"+-- From RFC2396:+-- rel_segment = 1*( unreserved | escaped |+-- ";" | "@" | "&" | "=" | "+" | "$" | "," )+-- unreserved = alphanum | mark+-- mark = "-" | "_" | "." | "!" | "~" | "*" | "'" |+-- "(" | ")"+-- Note RFC 2732 allows '[', ']' ONLY for reserved purpose of IPv6 literals,+-- or does it?+testURIRef101 = testURIRef InvRf "A[C"+testURIRef102 = testURIRef InvRf "A]C"+testURIRef103 = testURIRef InvRf "A[**]C"+testURIRef104 = testURIRef InvRf "http://[xyz]/"+testURIRef105 = testURIRef InvRf "http://]/"+testURIRef106 = testURIRef InvRf "http://example.org/[2010:836B:4179::836B:4179]"+testURIRef107 = testURIRef InvRf "http://example.org/abc#[2010:836B:4179::836B:4179]"+testURIRef108 = testURIRef InvRf "http://example.org/xxx/[qwerty]#a[b]"+-- Random other things that crop up+testURIRef111 = testURIRef AbsRf "http://example/Andrȷ"+testURIRef112 = testURIRef AbsId "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/"+testURIRef113 = testURIRef AbsId "http://46229EFFE16A9BD60B9F1BE88B2DB047ADDED785/demo.mp3"+testURIRef114 = testURIRef InvRf "http://example.org/xxx/qwerty#a#b"+testURIRef115 = testURIRef InvRf "dcp.tcp.pft://192.168.0.1:1002:3002?fec=1&crc=0"+testURIRef116 = testURIRef AbsId "dcp.tcp.pft://192.168.0.1:1002?fec=1&crc=0"+testURIRef117 = testURIRef AbsId "foo://"++testURIRefSuite = TestLabel "Test URIrefs" testURIRefList+testURIRefList = TestList+ [+ testURIRef001, testURIRef002, testURIRef003, testURIRef004,+ testURIRef005, testURIRef006, testURIRef007, testURIRef008,+ testURIRef009, testURIRef010,+ --+ testURIRef011, testURIRef012, testURIRef013, testURIRef014,+ testURIRef015, testURIRef016, testURIRef017, testURIRef018,+ --+ testURIRef019,+ --+ testURIRef021, testURIRef022, testURIRef023, testURIRef024,+ testURIRef025, testURIRef026, testURIRef027, testURIRef028,+ testURIRef029,+ --+ testURIRef031, testURIRef032, testURIRef033, testURIRef034,+ testURIRef035, testURIRef036, testURIRef037, testURIRef038,+ testURIRef039,+ testURIRef040, testURIRef041, testURIRef042, testURIRef043,+ testURIRef044, testURIRef045, testURIRef046, testURIRef047,+ testURIRef048, testURIRef049,+ testURIRef050, testURIRef051, testURIRef052, testURIRef053,+ testURIRef054, testURIRef055, testURIRef056, testURIRef057,+ testURIRef058, testURIRef059,+ testURIRef060, testURIRef061, testURIRef062, testURIRef063,+ testURIRef064, testURIRef065, testURIRef066, testURIRef067,+ testURIRef068, testURIRef069,+ testURIRef070, testURIRef071, testURIRef072, testURIRef073,+ testURIRef074, testURIRef075, testURIRef076, testURIRef077,+ --+ testURIRef080,+ testURIRef081, testURIRef082, testURIRef083, testURIRef084,+ testURIRef085, testURIRef086, testURIRef087, -- testURIRef088,+ -- testURIRef089,+ testURIRef090, testURIRef091, testURIRef092, testURIRef093,+ testURIRef094, testURIRef095, testURIRef096, testURIRef097,+ testURIRef098, -- testURIRef099,+ --+ testURIRef101, testURIRef102, testURIRef103, testURIRef104,+ testURIRef105, testURIRef106, testURIRef107, testURIRef108,+ --+ testURIRef111, testURIRef112, testURIRef113, testURIRef114,+ testURIRef115, testURIRef116, testURIRef117+ ]++-- test decomposition of URI into components+testComponent01 = testURIRefComponents "testComponent01"+ ( Just $ URI+ { uriScheme = "http:"+ , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+ , uriPath = "/aaa/bbb"+ , uriQuery = "?qqq"+ , uriFragment = "#fff"+ } )+ "http://user:pass@example.org:99/aaa/bbb?qqq#fff"+testComponent02 = testURIRefComponents "testComponent02"+ ( const Nothing+ ( Just $ URI+ { uriScheme = "http:"+ , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+ , uriPath = "aaa/bbb"+ , uriQuery = ""+ , uriFragment = ""+ } )+ )+ "http://user:pass@example.org:99aaa/bbb"+testComponent03 = testURIRefComponents "testComponent03"+ ( Just $ URI+ { uriScheme = "http:"+ , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+ , uriPath = ""+ , uriQuery = "?aaa/bbb"+ , uriFragment = ""+ } )+ "http://user:pass@example.org:99?aaa/bbb"+testComponent04 = testURIRefComponents "testComponent03"+ ( Just $ URI+ { uriScheme = "http:"+ , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+ , uriPath = ""+ , uriQuery = ""+ , uriFragment = "#aaa/bbb"+ } )+ "http://user:pass@example.org:99#aaa/bbb"+-- These test cases contributed by Robert Buck (mathworks.com)+testComponent11 = testURIRefComponents "testComponent03"+ ( Just $ URI+ { uriScheme = "about:"+ , uriAuthority = Nothing+ , uriPath = ""+ , uriQuery = ""+ , uriFragment = ""+ } )+ "about:"+testComponent12 = testURIRefComponents "testComponent03"+ ( Just $ URI+ { uriScheme = "file:"+ , uriAuthority = Just (URIAuth "" "windowsauth" "")+ , uriPath = "/d$"+ , uriQuery = ""+ , uriFragment = ""+ } )+ "file://windowsauth/d$"++testComponentSuite = TestLabel "Test URIrefs" $ TestList+ [ testComponent01+ , testComponent02+ , testComponent03+ , testComponent04+ , testComponent11+ , testComponent12+ ]++-- Get reference relative to given base+-- relativeRef :: String -> String -> String+--+-- Get absolute URI given base and relative reference+-- absoluteURI :: String -> String -> String+--+-- Test cases taken from: http://www.w3.org/2000/10/swap/uripath.py+-- (Thanks, Dan Connolly)+--+-- NOTE: absoluteURI base (relativeRef base u) is always equivalent to u.+-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html++testRelSplit :: String -> String -> String -> String -> Test+testRelSplit label base uabs urel =+ testEq label urel (mkrel puabs pubas)+ where+ mkrel (Just u1) (Just u2) = show (u1 `relativeFrom` u2)+ mkrel Nothing _ = "Invalid URI: "++urel+ mkrel _ Nothing = "Invalid URI: "++uabs+ puabs = parseURIReference uabs+ pubas = parseURIReference base++testRelJoin :: String -> String -> String -> String -> Test+testRelJoin label base urel uabs =+ testEq label uabs (mkabs purel pubas)+ where+ mkabs (Just u1) (Just u2) = shabs (u1 `relativeTo` u2)+ mkabs Nothing _ = "Invalid URI: "++urel+ mkabs _ Nothing = "Invalid URI: "++uabs+ shabs (Just u) = show u+ shabs Nothing = "No result"+ purel = parseURIReference urel+ pubas = parseURIReference base++testRelative :: String -> String -> String -> String -> Test+testRelative label base uabs urel = TestList+ [+ (testRelSplit (label++"(rel)") base uabs urel),+ (testRelJoin (label++"(abs)") base urel uabs)+ ]++testRelative01 = testRelative "testRelative01"+ "foo:xyz" "bar:abc" "bar:abc"+testRelative02 = testRelative "testRelative02"+ "http://example/x/y/z" "http://example/x/abc" "../abc"+testRelative03 = testRelative "testRelative03"+ "http://example2/x/y/z" "http://example/x/abc" "//example/x/abc"+ -- "http://example2/x/y/z" "http://example/x/abc" "http://example/x/abc"+testRelative04 = testRelative "testRelative04"+ "http://ex/x/y/z" "http://ex/x/r" "../r"+testRelative05 = testRelative "testRelative05"+ "http://ex/x/y/z" "http://ex/r" "/r"+ -- "http://ex/x/y/z" "http://ex/r" "../../r"+testRelative06 = testRelative "testRelative06"+ "http://ex/x/y/z" "http://ex/x/y/q/r" "q/r"+testRelative07 = testRelative "testRelative07"+ "http://ex/x/y" "http://ex/x/q/r#s" "q/r#s"+testRelative08 = testRelative "testRelative08"+ "http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t"+testRelative09 = testRelative "testRelative09"+ "http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"+testRelative10 = testRelative "testRelative10"+ -- "http://ex/x/y" "http://ex/x/y" "y"+ "http://ex/x/y" "http://ex/x/y" ""+testRelative11 = testRelative "testRelative11"+ -- "http://ex/x/y/" "http://ex/x/y/" "./"+ "http://ex/x/y/" "http://ex/x/y/" ""+testRelative12 = testRelative "testRelative12"+ -- "http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq"+ "http://ex/x/y/pdq" "http://ex/x/y/pdq" ""+testRelative13 = testRelative "testRelative13"+ "http://ex/x/y/" "http://ex/x/y/z/" "z/"+testRelative14 = testRelative "testRelative14"+ -- "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal"+ "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "#Animal"+testRelative15 = testRelative "testRelative15"+ "file:/e/x/y/z" "file:/e/x/abc" "../abc"+testRelative16 = testRelative "testRelative16"+ "file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc"+testRelative17 = testRelative "testRelative17"+ "file:/ex/x/y/z" "file:/ex/x/r" "../r"+testRelative18 = testRelative "testRelative18"+ "file:/ex/x/y/z" "file:/r" "/r"+testRelative19 = testRelative "testRelative19"+ "file:/ex/x/y" "file:/ex/x/q/r" "q/r"+testRelative20 = testRelative "testRelative20"+ "file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s"+testRelative21 = testRelative "testRelative21"+ "file:/ex/x/y" "file:/ex/x/q/r#" "q/r#"+testRelative22 = testRelative "testRelative22"+ "file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t"+testRelative23 = testRelative "testRelative23"+ "file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"+testRelative24 = testRelative "testRelative24"+ -- "file:/ex/x/y" "file:/ex/x/y" "y"+ "file:/ex/x/y" "file:/ex/x/y" ""+testRelative25 = testRelative "testRelative25"+ -- "file:/ex/x/y/" "file:/ex/x/y/" "./"+ "file:/ex/x/y/" "file:/ex/x/y/" ""+testRelative26 = testRelative "testRelative26"+ -- "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq"+ "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" ""+testRelative27 = testRelative "testRelative27"+ "file:/ex/x/y/" "file:/ex/x/y/z/" "z/"+testRelative28 = testRelative "testRelative28"+ "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"+ "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"+ -- "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"+ -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"+testRelative29 = testRelative "testRelative29"+ "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"+ "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"+ -- "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"+ -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"+testRelative30 = testRelative "testRelative30"+ "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"+testRelative31 = testRelative "testRelative31"+ "file:/some/dir/foo" "file:/some/dir/#" "./#"+testRelative32 = testRelative "testRelative32"+ "http://ex/x/y" "http://ex/x/q:r" "./q:r"+ -- see RFC2396bis, section 5 ^^+testRelative33 = testRelative "testRelative33"+ "http://ex/x/y" "http://ex/x/p=q:r" "./p=q:r"+ -- "http://ex/x/y" "http://ex/x/p=q:r" "p=q:r"+testRelative34 = testRelative "testRelative34"+ "http://ex/x/y?pp/qq" "http://ex/x/y?pp/rr" "?pp/rr"+testRelative35 = testRelative "testRelative35"+ "http://ex/x/y?pp/qq" "http://ex/x/y/z" "y/z"+testRelative36 = testRelative "testRelative36"+ "mailto:local"+ "mailto:local/qual@domain.org#frag"+ "local/qual@domain.org#frag"+testRelative37 = testRelative "testRelative37"+ "mailto:local/qual1@domain1.org"+ "mailto:local/more/qual2@domain2.org#frag"+ "more/qual2@domain2.org#frag"+testRelative38 = testRelative "testRelative38"+ "http://ex/x/z?q" "http://ex/x/y?q" "y?q"+testRelative39 = testRelative "testRelative39"+ "http://ex?p" "http://ex/x/y?q" "/x/y?q"+testRelative40 = testRelative "testRelative40"+ "foo:a/b" "foo:a/c/d" "c/d"+testRelative41 = testRelative "testRelative41"+ "foo:a/b" "foo:/c/d" "/c/d"+testRelative42 = testRelative "testRelative42"+ "foo:a/b?c#d" "foo:a/b?c" ""+testRelative43 = testRelative "testRelative42"+ "foo:a" "foo:b/c" "b/c"+testRelative44 = testRelative "testRelative44"+ "foo:/a/y/z" "foo:/a/b/c" "../b/c"+testRelative45 = testRelJoin "testRelative45"+ "foo:a" "./b/c" "foo:b/c"+testRelative46 = testRelJoin "testRelative46"+ "foo:a" "/./b/c" "foo:/b/c"+testRelative47 = testRelJoin "testRelative47"+ "foo://a//b/c" "../../d" "foo://a/d"+testRelative48 = testRelJoin "testRelative48"+ "foo:a" "." "foo:"+testRelative49 = testRelJoin "testRelative49"+ "foo:a" ".." "foo:"++-- add escape tests+testRelative50 = testRelative "testRelative50"+ "http://example/x/y%2Fz" "http://example/x/abc" "abc"+testRelative51 = testRelative "testRelative51"+ "http://example/a/x/y/z" "http://example/a/x%2Fabc" "../../x%2Fabc"+testRelative52 = testRelative "testRelative52"+ "http://example/a/x/y%2Fz" "http://example/a/x%2Fabc" "../x%2Fabc"+testRelative53 = testRelative "testRelative53"+ "http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc"+testRelative54 = testRelative "testRelative54"+ "http://ex/x/y" "http://ex/x/q%3Ar" "q%3Ar"+testRelative55 = testRelative "testRelative55"+ "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"+-- Apparently, TimBL prefers the following way to 41, 42 above+-- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html+-- He also notes that there may be different relative fuctions+-- that satisfy the basic equivalence axiom:+-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html+testRelative56 = testRelative "testRelative56"+ "http://example/x/y/z" "http://example/x%2Fabc" "/x%2Fabc"+testRelative57 = testRelative "testRelative57"+ "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"++-- Other oddball tests+ -- Check segment normalization code:+testRelative60 = testRelJoin "testRelative60"+ "ftp://example/x/y" "http://example/a/b/../../c" "http://example/c"+testRelative61 = testRelJoin "testRelative61"+ "ftp://example/x/y" "http://example/a/b/c/../../" "http://example/a/"+testRelative62 = testRelJoin "testRelative62"+ "ftp://example/x/y" "http://example/a/b/c/./" "http://example/a/b/c/"+testRelative63 = testRelJoin "testRelative63"+ "ftp://example/x/y" "http://example/a/b/c/.././" "http://example/a/b/"+testRelative64 = testRelJoin "testRelative64"+ "ftp://example/x/y" "http://example/a/b/c/d/../../../../e" "http://example/e"+testRelative65 = testRelJoin "testRelative65"+ "ftp://example/x/y" "http://example/a/b/c/d/../.././../../e" "http://example/e"+ -- Check handling of queries and fragments with non-relative paths+testRelative70 = testRelative "testRelative70"+ "mailto:local1@domain1?query1" "mailto:local2@domain2"+ "local2@domain2"+testRelative71 = testRelative "testRelative71"+ "mailto:local1@domain1" "mailto:local2@domain2?query2"+ "local2@domain2?query2"+testRelative72 = testRelative "testRelative72"+ "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"+ "local2@domain2?query2"+testRelative73 = testRelative "testRelative73"+ "mailto:local@domain?query1" "mailto:local@domain?query2"+ "?query2"+testRelative74 = testRelative "testRelative74"+ "mailto:?query1" "mailto:local@domain?query2"+ "local@domain?query2"+testRelative75 = testRelative "testRelative75"+ "mailto:local@domain?query1" "mailto:local@domain?query2"+ "?query2"+testRelative76 = testRelative "testRelative76"+ "foo:bar" "http://example/a/b?c/../d" "http://example/a/b?c/../d"+testRelative77 = testRelative "testRelative77"+ "foo:bar" "http://example/a/b#c/../d" "http://example/a/b#c/../d"+{- These (78-81) are some awkward test cases thrown up by a question on the URI list:+ http://lists.w3.org/Archives/Public/uri/2005Jul/0013+ Mote that RFC 3986 discards path segents after the final '/' only when merging two+ paths - otherwise the final segment in the base URI is mnaintained. This leads to+ difficulty in constructinmg a reversible relativeTo/relativeFrom pair of functions.+-}+testRelative78 = testRelative "testRelative78"+ "http://www.example.com/data/limit/.." "http://www.example.com/data/limit/test.xml"+ "test.xml"+testRelative79 = testRelative "testRelative79"+ "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"+testRelative80 = testRelative "testRelative80"+ "file:/some/dir/foo" "file:/some/dir/#" "./#"+testRelative81 = testRelative "testRelative81"+ "file:/some/dir/.." "file:/some/dir/#blort" "./#blort"++-- testRelative base abs rel+-- testRelSplit base abs rel+-- testRelJoin base rel abs+testRelative91 = testRelSplit "testRelative91"+ "http://example.org/base/uri" "http:this"+ "this"+testRelative92 = testRelJoin "testRelative92"+ "http://example.org/base/uri" "http:this"+ "http:this"+testRelative93 = testRelJoin "testRelative93"+ "http:base" "http:this"+ "http:this"+testRelative94 = testRelJoin "testRelative94"+ "f:/a" ".//g"+ "f://g"+testRelative95 = testRelJoin "testRelative95"+ "f://example.org/base/a" "b/c//d/e"+ "f://example.org/base/b/c//d/e"+testRelative96 = testRelJoin "testRelative96"+ "mid:m@example.ord/c@example.org" "m2@example.ord/c2@example.org"+ "mid:m@example.ord/m2@example.ord/c2@example.org"+testRelative97 = testRelJoin "testRelative97"+ "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" "mini1.xml"+ "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/mini1.xml"+testRelative98 = testRelative "testRelative98"+ "foo:a/y/z" "foo:a/b/c" "../b/c"+testRelative99 = testRelJoin "testRelative99"+ "f:/a/" "..//g"+ "f://g"+++testRelativeSuite = TestLabel "Test Relative URIs" testRelativeList+testRelativeList = TestList+ [ testRelative01, testRelative02, testRelative03, testRelative04+ , testRelative05, testRelative06, testRelative07, testRelative08+ , testRelative09+ , testRelative10, testRelative11, testRelative12, testRelative13+ , testRelative14, testRelative15, testRelative16, testRelative17+ , testRelative18, testRelative19+ , testRelative20, testRelative21, testRelative22, testRelative23+ , testRelative24, testRelative25, testRelative26, testRelative27+ , testRelative28, testRelative29+ , testRelative30, testRelative31, testRelative32, testRelative33+ , testRelative34, testRelative35, testRelative36, testRelative37+ , testRelative38, testRelative39+ , testRelative40, testRelative41, testRelative42, testRelative43+ , testRelative44, testRelative45, testRelative46, testRelative47+ , testRelative48, testRelative49+ --+ , testRelative50, testRelative51, testRelative52, testRelative53+ , testRelative54, testRelative55, testRelative56, testRelative57+ --+ , testRelative60, testRelative61, testRelative62, testRelative63+ , testRelative64, testRelative65+ --+ , testRelative70, testRelative71, testRelative72, testRelative73+ , testRelative74, testRelative75, testRelative76, testRelative77+ -- Awkward cases:+ , testRelative78, testRelative79, testRelative80, testRelative81+ --+ -- , testRelative90+ , testRelative91, testRelative92, testRelative93+ , testRelative94, testRelative95, testRelative96+ , testRelative97, testRelative98, testRelative99+ ]++-- RFC2396 relative-to-absolute URI tests++rfcbase = "http://a/b/c/d;p?q"+-- normal cases, RFC2396bis 5.4.1+testRFC01 = testRelJoin "testRFC01" rfcbase "g:h" "g:h"+testRFC02 = testRelJoin "testRFC02" rfcbase "g" "http://a/b/c/g"+testRFC03 = testRelJoin "testRFC03" rfcbase "./g" "http://a/b/c/g"+testRFC04 = testRelJoin "testRFC04" rfcbase "g/" "http://a/b/c/g/"+testRFC05 = testRelJoin "testRFC05" rfcbase "/g" "http://a/g"+testRFC06 = testRelJoin "testRFC06" rfcbase "//g" "http://g"+testRFC07 = testRelJoin "testRFC07" rfcbase "?y" "http://a/b/c/d;p?y"+testRFC08 = testRelJoin "testRFC08" rfcbase "g?y" "http://a/b/c/g?y"+testRFC09 = testRelJoin "testRFC09" rfcbase "?q#s" "http://a/b/c/d;p?q#s"+testRFC23 = testRelJoin "testRFC10" rfcbase "#s" "http://a/b/c/d;p?q#s"+testRFC10 = testRelJoin "testRFC11" rfcbase "g#s" "http://a/b/c/g#s"+testRFC11 = testRelJoin "testRFC12" rfcbase "g?y#s" "http://a/b/c/g?y#s"+testRFC12 = testRelJoin "testRFC13" rfcbase ";x" "http://a/b/c/;x"+testRFC13 = testRelJoin "testRFC14" rfcbase "g;x" "http://a/b/c/g;x"+testRFC14 = testRelJoin "testRFC15" rfcbase "g;x?y#s" "http://a/b/c/g;x?y#s"+testRFC24 = testRelJoin "testRFC16" rfcbase "" "http://a/b/c/d;p?q"+testRFC15 = testRelJoin "testRFC17" rfcbase "." "http://a/b/c/"+testRFC16 = testRelJoin "testRFC18" rfcbase "./" "http://a/b/c/"+testRFC17 = testRelJoin "testRFC19" rfcbase ".." "http://a/b/"+testRFC18 = testRelJoin "testRFC20" rfcbase "../" "http://a/b/"+testRFC19 = testRelJoin "testRFC21" rfcbase "../g" "http://a/b/g"+testRFC20 = testRelJoin "testRFC22" rfcbase "../.." "http://a/"+testRFC21 = testRelJoin "testRFC23" rfcbase "../../" "http://a/"+testRFC22 = testRelJoin "testRFC24" rfcbase "../../g" "http://a/g"+-- abnormal cases, RFC2396bis 5.4.2+testRFC31 = testRelJoin "testRFC31" rfcbase "?q" rfcbase+testRFC32 = testRelJoin "testRFC32" rfcbase "../../../g" "http://a/g"+testRFC33 = testRelJoin "testRFC33" rfcbase "../../../../g" "http://a/g"+testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/g"+testRFC35 = testRelJoin "testRFC35" rfcbase "/../g" "http://a/g"+testRFC36 = testRelJoin "testRFC36" rfcbase "g." "http://a/b/c/g."+testRFC37 = testRelJoin "testRFC37" rfcbase ".g" "http://a/b/c/.g"+testRFC38 = testRelJoin "testRFC38" rfcbase "g.." "http://a/b/c/g.."+testRFC39 = testRelJoin "testRFC39" rfcbase "..g" "http://a/b/c/..g"+testRFC40 = testRelJoin "testRFC40" rfcbase "./../g" "http://a/b/g"+testRFC41 = testRelJoin "testRFC41" rfcbase "./g/." "http://a/b/c/g/"+testRFC42 = testRelJoin "testRFC42" rfcbase "g/./h" "http://a/b/c/g/h"+testRFC43 = testRelJoin "testRFC43" rfcbase "g/../h" "http://a/b/c/h"+testRFC44 = testRelJoin "testRFC44" rfcbase "g;x=1/./y" "http://a/b/c/g;x=1/y"+testRFC45 = testRelJoin "testRFC45" rfcbase "g;x=1/../y" "http://a/b/c/y"+testRFC46 = testRelJoin "testRFC46" rfcbase "g?y/./x" "http://a/b/c/g?y/./x"+testRFC47 = testRelJoin "testRFC47" rfcbase "g?y/../x" "http://a/b/c/g?y/../x"+testRFC48 = testRelJoin "testRFC48" rfcbase "g#s/./x" "http://a/b/c/g#s/./x"+testRFC49 = testRelJoin "testRFC49" rfcbase "g#s/../x" "http://a/b/c/g#s/../x"+testRFC50 = testRelJoin "testRFC50" rfcbase "http:x" "http:x"++-- Null path tests+-- See RFC2396bis, section 5.2,+-- "If the base URI's path component is the empty string, then a single+-- slash character is copied to the buffer"+testRFC60 = testRelative "testRFC60" "http://ex" "http://ex/x/y?q" "/x/y?q"+testRFC61 = testRelJoin "testRFC61" "http://ex" "x/y?q" "http://ex/x/y?q"+testRFC62 = testRelative "testRFC62" "http://ex?p" "http://ex/x/y?q" "/x/y?q"+testRFC63 = testRelJoin "testRFC63" "http://ex?p" "x/y?q" "http://ex/x/y?q"+testRFC64 = testRelative "testRFC64" "http://ex#f" "http://ex/x/y?q" "/x/y?q"+testRFC65 = testRelJoin "testRFC65" "http://ex#f" "x/y?q" "http://ex/x/y?q"+testRFC66 = testRelative "testRFC66" "http://ex?p" "http://ex/x/y#g" "/x/y#g"+testRFC67 = testRelJoin "testRFC67" "http://ex?p" "x/y#g" "http://ex/x/y#g"+testRFC68 = testRelative "testRFC68" "http://ex" "http://ex/" "/"+testRFC69 = testRelJoin "testRFC69" "http://ex" "./" "http://ex/"+testRFC70 = testRelative "testRFC70" "http://ex" "http://ex/a/b" "/a/b"+testRFC71 = testRelative "testRFC71" "http://ex/a/b" "http://ex" "./"++testRFC2396Suite = TestLabel "Test RFC2396 examples" testRFC2396List+testRFC2396List = TestList+ [+ testRFC01, testRFC02, testRFC03, testRFC04,+ testRFC05, testRFC06, testRFC07, testRFC08,+ testRFC09,+ testRFC10, testRFC11, testRFC12, testRFC13,+ testRFC14, testRFC15, testRFC16, testRFC17,+ testRFC18, testRFC19,+ testRFC20, testRFC21, testRFC22, testRFC23,+ testRFC24,+ -- testRFC30,+ testRFC31, testRFC32, testRFC33,+ testRFC34, testRFC35, testRFC36, testRFC37,+ testRFC38, testRFC39,+ testRFC40, testRFC41, testRFC42, testRFC43,+ testRFC44, testRFC45, testRFC46, testRFC47,+ testRFC48, testRFC49,+ testRFC50,+ --+ testRFC60, testRFC61, testRFC62, testRFC63,+ testRFC64, testRFC65, testRFC66, testRFC67,+ testRFC68, testRFC69,+ testRFC70+ ]++-- And some other oddballs:+mailbase = "mailto:local/option@domain.org?notaquery#frag"+testMail01 = testRelJoin "testMail01"+ mailbase "more@domain"+ "mailto:local/more@domain"+testMail02 = testRelJoin "testMail02"+ mailbase "#newfrag"+ "mailto:local/option@domain.org?notaquery#newfrag"+testMail03 = testRelJoin "testMail03"+ mailbase "l1/q1@domain"+ "mailto:local/l1/q1@domain"++testMail11 = testRelJoin "testMail11"+ "mailto:local1@domain1?query1" "mailto:local2@domain2"+ "mailto:local2@domain2"+testMail12 = testRelJoin "testMail12"+ "mailto:local1@domain1" "mailto:local2@domain2?query2"+ "mailto:local2@domain2?query2"+testMail13 = testRelJoin "testMail13"+ "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"+ "mailto:local2@domain2?query2"+testMail14 = testRelJoin "testMail14"+ "mailto:local@domain?query1" "mailto:local@domain?query2"+ "mailto:local@domain?query2"+testMail15 = testRelJoin "testMail15"+ "mailto:?query1" "mailto:local@domain?query2"+ "mailto:local@domain?query2"+testMail16 = testRelJoin "testMail16"+ "mailto:local@domain?query1" "?query2"+ "mailto:local@domain?query2"+testInfo17 = testRelJoin "testInfo17"+ "info:name/1234/../567" "name/9876/../543"+ "info:name/name/543"+testInfo18 = testRelJoin "testInfo18"+ "info:/name/1234/../567" "name/9876/../543"+ "info:/name/name/543"++testOddballSuite = TestLabel "Test oddball examples" testOddballList+testOddballList = TestList+ [ testMail01, testMail02, testMail03+ , testMail11, testMail12, testMail13, testMail14, testMail15, testMail16+ , testInfo17+ ]++-- Normalization tests++-- Case normalization; cf. RFC2396bis section 6.2.2.1+-- NOTE: authority case normalization is not performed+testNormalize01 = testEq "testNormalize01"+ "http://EXAMPLE.com/Root/%2A?%2B#%2C"+ (normalizeCase "HTTP://EXAMPLE.com/Root/%2a?%2b#%2c")++-- Encoding normalization; cf. RFC2396bis section 6.2.2.2+testNormalize11 = testEq "testNormalize11"+ "HTTP://EXAMPLE.com/Root/~Me/"+ (normalizeEscape "HTTP://EXAMPLE.com/Root/%7eMe/")+testNormalize12 = testEq "testNormalize12"+ "foo:%40AZ%5b%60az%7b%2f09%3a-._~"+ (normalizeEscape "foo:%40%41%5a%5b%60%61%7a%7b%2f%30%39%3a%2d%2e%5f%7e")+testNormalize13 = testEq "testNormalize13"+ "foo:%3a%2f%3f%23%5b%5d%40"+ (normalizeEscape "foo:%3a%2f%3f%23%5b%5d%40")++-- Path segment normalization; cf. RFC2396bis section 6.2.2.4+testNormalize21 = testEq "testNormalize21"+ "http://example/c"+ (normalizePathSegments "http://example/a/b/../../c")+testNormalize22 = testEq "testNormalize22"+ "http://example/a/"+ (normalizePathSegments "http://example/a/b/c/../../")+testNormalize23 = testEq "testNormalize23"+ "http://example/a/b/c/"+ (normalizePathSegments "http://example/a/b/c/./")+testNormalize24 = testEq "testNormalize24"+ "http://example/a/b/"+ (normalizePathSegments "http://example/a/b/c/.././")+testNormalize25 = testEq "testNormalize25"+ "http://example/e"+ (normalizePathSegments "http://example/a/b/c/d/../../../../e")+testNormalize26 = testEq "testNormalize26"+ "http://example/e"+ (normalizePathSegments "http://example/a/b/c/d/../.././../../e")+testNormalize27 = testEq "testNormalize27"+ "http://example/e"+ (normalizePathSegments "http://example/a/b/../.././../../e")+testNormalize28 = testEq "testNormalize28"+ "foo:e"+ (normalizePathSegments "foo:a/b/../.././../../e")++testNormalizeSuite = TestList+ [ testNormalize01+ , testNormalize11+ , testNormalize12+ , testNormalize13+ , testNormalize21, testNormalize22, testNormalize23, testNormalize24+ , testNormalize25, testNormalize26, testNormalize27, testNormalize28+ ]++-- URI formatting (show) tests++ts02URI = URI { uriScheme = "http:"+ , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+ , uriPath = "/aaa/bbb"+ , uriQuery = "?ccc"+ , uriFragment = "#ddd/eee"+ }++ts04URI = URI { uriScheme = "http:"+ , uriAuthority = Just (URIAuth "user:anonymous@" "example.org" ":99")+ , uriPath = "/aaa/bbb"+ , uriQuery = "?ccc"+ , uriFragment = "#ddd/eee"+ }++ts02str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee"+ts03str = "http://user:pass@example.org:99/aaa/bbb?ccc#ddd/eee"+ts04str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee"++testShowURI01 = testEq "testShowURI01" "" (show nullURI)+testShowURI02 = testEq "testShowURI02" ts02str (show ts02URI)+testShowURI03 = testEq "testShowURI03" ts03str ((uriToString id ts02URI) "")+testShowURI04 = testEq "testShowURI04" ts04str (show ts04URI)++testShowURI = TestList+ [ testShowURI01+ , testShowURI02+ , testShowURI03+ , testShowURI04+ ]+++-- URI escaping tests++te01str = "http://example.org/az/09-_/.~:/?#[]@!$&'()*+,;="+te02str = "http://example.org/a</b>/c%/d /e"+te02esc = "http://example.org/a%3C/b%3E/c%25/d%20/e"++testEscapeURIString01 = testEq "testEscapeURIString01"+ te01str (escapeURIString isUnescapedInURI te01str)++testEscapeURIString02 = testEq "testEscapeURIString02"+ te02esc (escapeURIString isUnescapedInURI te02str)++testEscapeURIString03 = testEq "testEscapeURIString03"+ te01str (unEscapeString te01str)++testEscapeURIString04 = testEq "testEscapeURIString04"+ te02str (unEscapeString te02esc)+++testEscapeURIString = TestList+ [ testEscapeURIString01+ , testEscapeURIString02+ , testEscapeURIString03+ , testEscapeURIString04+ ]++-- URI string normalization tests++tn01str = "eXAMPLE://a/b/%7bfoo%7d"+tn01nrm = "example://a/b/%7Bfoo%7D"++tn02str = "example://a/b/%63/"+tn02nrm = "example://a/b/c/"++tn03str = "example://a/./b/../b/c/foo"+tn03nrm = "example://a/b/c/foo"++tn04str = "eXAMPLE://a/b/%7bfoo%7d" -- From RFC2396bis, 6.2.2+tn04nrm = "example://a/b/%7Bfoo%7D"++tn06str = "file:/x/..//y"+tn06nrm = "file://y"++tn07str = "file:x/..//y/"+tn07nrm = "file:/y/"++testNormalizeURIString01 = testEq "testNormalizeURIString01"+ tn01nrm (normalizeCase tn01str)+testNormalizeURIString02 = testEq "testNormalizeURIString02"+ tn02nrm (normalizeEscape tn02str)+testNormalizeURIString03 = testEq "testNormalizeURIString03"+ tn03nrm (normalizePathSegments tn03str)+testNormalizeURIString04 = testEq "testNormalizeURIString04"+ tn04nrm ((normalizeCase . normalizeEscape . normalizePathSegments) tn04str)+testNormalizeURIString05 = testEq "testNormalizeURIString05"+ tn04nrm ((normalizePathSegments . normalizeEscape . normalizeCase) tn04str)+testNormalizeURIString06 = testEq "testNormalizeURIString06"+ tn06nrm (normalizePathSegments tn06str)+testNormalizeURIString07 = testEq "testNormalizeURIString07"+ tn07nrm (normalizePathSegments tn07str)++testNormalizeURIString = TestList+ [ testNormalizeURIString01+ , testNormalizeURIString02+ , testNormalizeURIString03+ , testNormalizeURIString04+ , testNormalizeURIString05+ , testNormalizeURIString06+ , testNormalizeURIString07+ ]++tnus67 = runTestTT $ TestList+ [ testNormalizeURIString06+ , testNormalizeURIString07+ ]++-- Test strict vs non-strict relativeTo logic++trbase = fromJust $ parseURIReference "http://bar.org/"++testRelativeTo01 = testEq "testRelativeTo01"+ "http://bar.org/foo"+ (show . fromJust $+ (fromJust $ parseURIReference "foo") `relativeTo` trbase)++testRelativeTo02 = testEq "testRelativeTo02"+ "http:foo"+ (show . fromJust $+ (fromJust $ parseURIReference "http:foo") `relativeTo` trbase)++testRelativeTo03 = testEq "testRelativeTo03"+ "http://bar.org/foo"+ (show . fromJust $+ (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase)++testRelativeTo = TestList+ [ testRelativeTo01+ , testRelativeTo02+ , testRelativeTo03+ ]++-- Test alternative parsing functions+testAltFn01 = testEq "testAltFn01" "Just http://a.b/c#f"+ (show . parseURI $ "http://a.b/c#f")+testAltFn02 = testEq "testAltFn02" "Just http://a.b/c#f"+ (show . parseURIReference $ "http://a.b/c#f")+testAltFn03 = testEq "testAltFn03" "Just c/d#f"+ (show . parseRelativeReference $ "c/d#f")+testAltFn04 = testEq "testAltFn04" "Nothing"+ (show . parseRelativeReference $ "http://a.b/c#f")+testAltFn05 = testEq "testAltFn05" "Just http://a.b/c"+ (show . parseAbsoluteURI $ "http://a.b/c")+testAltFn06 = testEq "testAltFn06" "Nothing"+ (show . parseAbsoluteURI $ "http://a.b/c#f")+testAltFn07 = testEq "testAltFn07" "Nothing"+ (show . parseAbsoluteURI $ "c/d")+testAltFn08 = testEq "testAltFn08" "Just http://a.b/c"+ (show . parseabsoluteURI $ "http://a.b/c")++testAltFn11 = testEq "testAltFn11" True (isURI "http://a.b/c#f")+testAltFn12 = testEq "testAltFn12" True (isURIReference "http://a.b/c#f")+testAltFn13 = testEq "testAltFn13" True (isRelativeReference "c/d#f")+testAltFn14 = testEq "testAltFn14" False (isRelativeReference "http://a.b/c#f")+testAltFn15 = testEq "testAltFn15" True (isAbsoluteURI "http://a.b/c")+testAltFn16 = testEq "testAltFn16" False (isAbsoluteURI "http://a.b/c#f")+testAltFn17 = testEq "testAltFn17" False (isAbsoluteURI "c/d")++testAltFn = TestList+ [ testAltFn01+ , testAltFn02+ , testAltFn03+ , testAltFn04+ , testAltFn05+ , testAltFn06+ , testAltFn07+ , testAltFn08+ , testAltFn11+ , testAltFn12+ , testAltFn13+ , testAltFn14+ , testAltFn15+ , testAltFn16+ , testAltFn17+ ]++-- Full test suite+allTests = TestList+ [ testURIRefSuite+ , testComponentSuite+ , testRelativeSuite+ , testRFC2396Suite+ , testOddballSuite+ , testNormalizeSuite+ , testShowURI+ , testEscapeURIString+ , testNormalizeURIString+ , testRelativeTo+ , testAltFn+ ]++main = runTestTT allTests++runTestFile t = do+ h <- openFile "a.tmp" WriteMode+ runTestText (putTextToHandle h False) t+ hClose h+tf = runTestFile+tt = runTestTT++-- Miscellaneous values for hand-testing/debugging in Hugs:++uref = testURIRefSuite+tr01 = testRelative01+tr02 = testRelative02+tr03 = testRelative03+tr04 = testRelative04+rel = testRelativeSuite+rfc = testRFC2396Suite+oddb = testOddballSuite++(Just bu02) = parseURIReference "http://example/x/y/z"+(Just ou02) = parseURIReference "../abc"+(Just ru02) = parseURIReference "http://example/x/abc"+-- fileuri = testURIReference "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/"++cu02 = ou02 `relativeTo` bu02++--------------------------------------------------------------------------------+--+-- Copyright (c) 2004, G. KLYNE. All rights reserved.+-- Distributed as free software under the following license.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions+-- are met:+--+-- - Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer.+--+-- - Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution.+--+-- - Neither name of the copyright holders nor the names of its+-- contributors may be used to endorse or promote products derived from+-- this software without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS+-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+-- HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS+-- OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR+-- TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+-- USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+--+--------------------------------------------------------------------------------+-- $Source: /srv/cvs/cvs.haskell.org/fptools/libraries/network/tests/URITest.hs,v $+-- $Author: gklyne $+-- $Revision: 1.8 $+-- $Log: URITest.hs,v $+-- Revision 1.8 2005/07/19 22:01:27 gklyne+-- Added some additional test cases raised by discussion on URI@w3.org mailing list about 2005-07-19. The test p[roposed by this discussion exposed a subtle bug in relativeFrom not being an exact inverse of relativeTo.+--+-- Revision 1.7 2005/06/06 16:31:44 gklyne+-- Added two new test cases.+--+-- Revision 1.6 2005/05/31 17:18:36 gklyne+-- Added some additional test cases triggered by URI-list discussions.+--+-- Revision 1.5 2005/04/07 11:09:37 gklyne+-- Added test cases for alternate parsing functions (including deprecated 'parseabsoluteURI')+--+-- Revision 1.4 2005/04/05 12:47:32 gklyne+-- Added test case.+-- Changed module name, now requires GHC -main-is to compile.+-- All tests run OK with GHC 6.4 on MS-Windows.+--+-- Revision 1.3 2004/11/05 17:29:09 gklyne+-- Changed password-obscuring logic to reflect late change in revised URI+-- specification (password "anonymous" is no longer a special case).+-- Updated URI test module to use function 'escapeURIString'.+-- (Should unEscapeString be similarly updated?)+--+-- Revision 1.2 2004/10/27 13:06:55 gklyne+-- Updated URI module function names per:+-- http://www.haskell.org//pipermail/cvs-libraries/2004-October/002916.html+-- Added test cases to give better covereage of module functions.+--+-- Revision 1.1 2004/10/14 16:11:30 gklyne+-- Add URI unit test to cvs.haskell.org repository+--+-- Revision 1.17 2004/10/14 11:51:09 graham+-- Confirm that URITest runs with GHC.+-- Fix up some comments and other minor details.+--+-- Revision 1.16 2004/10/14 11:45:30 graham+-- Use moduke name main for GHC 6.2+--+-- Revision 1.15 2004/08/11 11:07:39 graham+-- Add new test case.+--+-- Revision 1.14 2004/06/30 11:35:27 graham+-- Update URI code to use hierarchical libraries for Parsec and Network.+--+-- Revision 1.13 2004/06/22 16:19:16 graham+-- New URI test case added.+--+-- Revision 1.12 2004/04/21 15:13:29 graham+-- Add test case+--+-- Revision 1.11 2004/04/21 14:54:05 graham+-- Fix up some tests+--+-- Revision 1.10 2004/04/20 14:54:13 graham+-- Fix up test cases related to port number in authority,+-- and add some more URI decomposition tests.+--+-- Revision 1.9 2004/04/07 15:06:17 graham+-- Add extra test case+-- Revise syntax in line with changes to RFC2396bis+--+-- Revision 1.8 2004/03/17 14:34:58 graham+-- Add Network.HTTP files to CVS+--+-- Revision 1.7 2004/03/16 14:19:38 graham+-- Change licence to BSD style; add nullURI definition; new test cases.+--+-- Revision 1.6 2004/02/20 12:12:00 graham+-- Add URI normalization functions+--+-- Revision 1.5 2004/02/19 23:19:35 graham+-- Network.URI module passes all test cases+--+-- Revision 1.4 2004/02/17 20:06:02 graham+-- Revised URI parser to reflect latest RFC2396bis (-04)+--+-- Revision 1.3 2004/02/11 14:32:14 graham+-- Added work-in-progress notes.+--+-- Revision 1.2 2004/02/02 14:00:39 graham+-- Fix optional host name in URI. Add test cases.+--+-- Revision 1.1 2004/01/27 21:13:45 graham+-- New URI module and test suite added,+-- implementing the GHC Network.URI interface.+--