packages feed

courier 0.1.0.13 → 0.1.0.14

raw patch · 8 files changed

+791/−1 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

changes.md view
@@ -1,3 +1,7 @@+0.1.0.14++    * Included test source into tarball+ 0.1.0.13      * Explicitly removed support for 7.4; 7.6 now required.
courier.cabal view
@@ -1,5 +1,5 @@ name:                courier-version:             0.1.0.13+version:             0.1.0.14 synopsis:           A message-passing library for simplifying network applications description:         Inspired by Erlang's simple message-passing facilities, courier provides roughly similar                       capabilities. Applications simply create one or more endpoints, @@ -25,6 +25,14 @@                       extra-source-files:  changes.md                      examples/HelloWorld.hs+                     tests/Tests.hs+                     tests/TestMailbox.hs+                     tests/TestMemory.hs+                     tests/TestRPC.hs+                     tests/TestTCP.hs+                     tests/TestTransports.hs+                     tests/TestUDP.hs+ homepage:          http://github.com/hargettp/courier license:             MIT license-file:        LICENSE
+ tests/TestMailbox.hs view
@@ -0,0 +1,107 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestMailbox+-- Copyright   :  (c) Phil Hargett 2014+-- License     :  MIT (see LICENSE file)+-- +-- Maintainer  :  phil@haphazardhouse.net+-- Stability   :  experimental+-- Portability :  non-portable (requires STM)+--+-- (..... module description .....)+--+-----------------------------------------------------------------------------++module TestMailbox (tests) where++-- local imports++import Control.Concurrent+import Control.Concurrent.Async+import Control.Concurrent.Mailbox+import Control.Concurrent.STM++-- external imports++import Test.Framework+import Test.HUnit+import Test.Framework.Providers.HUnit++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++tests :: [Test.Framework.Test]+tests = [+    testCase "mbox-creation" testCreation,+    testCase "mbox-simple-write" testSimpleWrite,+    testCase "mbox-write-read" testWriteRead,+    testCase "mbox-match" testMatch,+    testCase "mbox-find" testFind+  ]++testCreation :: Assertion+testCreation = do+    _ <- atomically $ newMailbox+    return ()++testSimpleWrite :: Assertion+testSimpleWrite = do+    mbox <- atomically $ newMailbox+    atomically $ writeMailbox mbox "hello!"+    return ()++testWriteRead :: Assertion+testWriteRead = do+    mbox <- atomically $ newMailbox+    atomically $ writeMailbox mbox "hello!"+    results <- race (atomically $ readMailbox mbox)+        (threadDelay 1000000)+    case results of+        Left msg -> assertEqual "Read message did not match written message" msg "hello!"+        Right _ -> assertFailure "No message read"++testMatch :: Assertion+testMatch = do+    mbox <- atomically $ newMailbox+    atomically $ writeMailbox mbox "hello!"+    results1 <- race (atomically $ expectHello mbox)+        (atomically $ expectBonjour mbox)+    case results1 of+        Left _ -> return ()+        Right _ -> assertFailure "Did not receive expected message"+    atomically $ writeMailbox mbox "bonjour!"+    results2 <- race (atomically $ expectHello mbox)+        (atomically $ expectBonjour mbox)+    case results2 of+        Left _ -> assertFailure "Did not receive expected message"+        Right _ -> return ()+    where+        expectHello mbox = selectMailbox mbox (\msg ->  if msg == "hello!" then Just msg else Nothing)+        expectBonjour mbox = selectMailbox mbox (\msg ->  if msg == "bonjour!" then Just msg else Nothing)++testFind :: Assertion+testFind = do+    mbox <- atomically $ newMailbox+    atomically $ writeMailbox mbox "hello!"+    results1 <- race (atomically $ expectHello mbox)+        (threadDelay 1000000)+    case results1 of+        Left _ -> return ()+        Right _ -> assertFailure "Did not find expected message"+    atomically $ writeMailbox mbox "bonjour!"+    results2 <- race (atomically $ expectHello mbox)+        (threadDelay 1000000)+    case results2 of+        Left _ -> return ()+        Right _ -> assertFailure "Did not find expected message"+    results3 <- atomically $ useHello mbox+    assertBool "Expected hello!" (results3 == "hello!")+    results4 <- race (atomically $ expectHello mbox)+        (atomically $ expectBonjour mbox)+    case results4 of+        Left _ -> assertFailure "Did not receive expected message"+        Right _ -> return ()+    where+        useHello mbox = selectMailbox mbox (\msg ->  if msg == "hello!" then Just msg else Nothing)+        expectHello mbox = findMailbox mbox (\msg ->  if msg == "hello!" then Just msg else Nothing)+        expectBonjour mbox = findMailbox mbox (\msg ->  if msg == "bonjour!" then Just msg else Nothing)
+ tests/TestMemory.hs view
@@ -0,0 +1,75 @@+module TestMemory (tests) where++-- local imports++import Network.Endpoints+import Network.Transport.Memory++-- external imports++import Data.Serialize++import Test.Framework+import Test.HUnit+import Test.Framework.Providers.HUnit+-- import Test.Framework.Providers.QuickCheck2++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++tests :: [Test.Framework.Test]+tests = [+    testCase "mem-endpoints+transport" testEndpointTransport,+    testCase "mem-bind" testEndpointBind,+    testCase "mem-unbind" testEndpointBindUnbind,+    testCase "mem-sendReceive" testEndpointSendReceive,+    testCase "mem-transport" testMemoryTransport+  ] +  +testEndpointTransport :: Assertion  +testEndpointTransport = do  +  transport <- newMemoryTransport+  _ <- newEndpoint [transport]+  return ()+  +testEndpointBind :: Assertion+testEndpointBind = do  +  let name1 = "endpoint1"+  transport <- newMemoryTransport+  endpoint <- newEndpoint [transport]+  Right () <- bindEndpoint endpoint name1+  return ()++testEndpointBindUnbind :: Assertion+testEndpointBindUnbind = do  +  let name1 = "endpoint1"+  transport <- newMemoryTransport+  endpoint <- newEndpoint [transport]+  Right () <- bindEndpoint endpoint name1+  unbound <- unbindEndpoint endpoint name1+  case unbound of+    Left err -> assertFailure $ "Unbind failed: " ++ err+    Right () -> assertBool "Unbind succeeded" True+  return ()+  +testEndpointSendReceive :: Assertion  +testEndpointSendReceive = do+  let name1 = "endpoint1"+      name2 = "endpoint2"+  transport <- newMemoryTransport+  endpoint1 <- newEndpoint [transport]+  endpoint2 <- newEndpoint [transport]+  Right () <- bindEndpoint endpoint1 name1+  Right () <- bindEndpoint endpoint2 name2+  _ <- sendMessage endpoint1 name2 $ encode "hello!"+  msg <- receiveMessage endpoint2    +  assertEqual "Received message not same as sent" (Right "hello!") (decode msg)+  return ()+  +-- Memory tests+  +testMemoryTransport :: Assertion+testMemoryTransport = do+  _ <- newMemoryTransport+  return ()+
+ tests/TestRPC.hs view
@@ -0,0 +1,265 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestRPC+-- Copyright   :  (c) Phil Hargett 2014+-- License     :  MIT (see LICENSE file)+-- +-- Maintainer  :  phil@haphazardhouse.net+-- Stability   :  experimental+-- Portability :  non-portable (requires STM)+--+-- (..... module description .....)+--+-----------------------------------------------------------------------------++module TestRPC (+    tests+) where++-- local imports++import Network.Endpoints+import Network.RPC+import Network.Transport.Memory++-- external imports++import Control.Applicative+import Control.Concurrent+import Control.Concurrent.Async++import qualified Data.Map as M+import Data.Serialize++import Test.Framework+import Test.HUnit+import Test.Framework.Providers.HUnit++--------------------------------------------------------------------------------+--------------------------------------------------------------------------------++_log :: String+_log = "test.rpc"++tests :: [Test.Framework.Test]+tests = [+    testCase "call-one-hear-call" testOneHearCall,+    testCase "call-one-call-hear" testOneCallHear,+    testCase "call-concurrent-call-hear" testConcurrentCallHear,+    testCase "call-one-handler" testOneHandler,+    testCase "call-two-handlers" testTwoHandlers,+    testCase "gcall-three-handlers" testGroupCall,+    testCase "call-one-with-timeout" testOneHandlerWithTimeout,+    testCase "gcall-three-handlers-with-timeout"testGroupCallWithTimeout+  ]++testOneHearCall :: Assertion+testOneHearCall = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    _ <- async $ do+        (bytes,reply) <- hear endpoint2 name2 "foo"+        let Right msg = decode bytes+        reply $ encode $ msg ++ "!"+    let cs = newCallSite endpoint1 name1+    bytes <- call cs name2 "foo" $ encode "hello"+    let Right result = decode bytes+    assertEqual "Result not expected value" "hello!" result++testOneCallHear :: Assertion+testOneCallHear = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    let cs = newCallSite endpoint1 name1+    acall <- async $ call cs name2 "foo" $ encode "hello"+    _ <- async $ do+        (bytes,reply) <- hear endpoint2 name2 "foo"+        let Right msg = decode bytes+        reply $ encode $ msg ++ "!"+    bytes <- wait acall+    let Right result = decode bytes+    assertEqual "Result not expected value" "hello!" result++testConcurrentCallHear :: Assertion+testConcurrentCallHear = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    let cs1 = newCallSite endpoint1 name1+        cs2 = newCallSite endpoint2 name2+    let call1 = call cs1 name2 "foo" $ encode "hello"+        hear1 = do+            (bytes,reply) <- hear endpoint2 name2 "foo"+            let Right msg = decode bytes+            reply $ encode $ msg ++ "!"+        call2 = call cs2 name1 "bar" $ encode "ciao"+        hear2 = do+            (bytes,reply) <- hear endpoint1 name1 "bar"+            let Right msg = decode bytes+            reply $ encode $ msg ++ "!"+    (result1,(),result2,()) <- runConcurrently $ (,,,)+        <$> Concurrently call1+        <*> Concurrently hear1+        <*> Concurrently call2+        <*> Concurrently hear2+    assertEqual "Result not expected value" (Right "hello!") (decode result1)+    assertEqual "Result not expected value" (Right "ciao!")  (decode result2)++testOneHandler :: Assertion+testOneHandler = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    h <- handle endpoint2 name2 "foo" $ \bytes ->+        let Right msg = decode bytes+        in return $ encode $ msg ++ "!"+    let cs = newCallSite endpoint1 name1+    bytes <- call cs name2 "foo" $ encode "hello"+    let Right result = decode bytes+    assertEqual "Result not expected value" "hello!" result+    hangup h++testTwoHandlers :: Assertion+testTwoHandlers = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    h1 <- handle endpoint2 name2 "foo" $ \bytes ->+        let Right msg = decode bytes+        in return $ encode $ msg ++ "!"+    h2 <- handle endpoint2 name2 "bar" $ \bytes ->+        let Right msg = decode bytes+        in return $ encode $ msg ++ "?"+    let cs = newCallSite endpoint1 name1+    bytes1 <- call cs name2 "foo" $ encode "hello"+    let Right result1 = decode bytes1+    assertEqual "Result not expected value" "hello!" result1+    bytes2 <- call cs name2 "bar" $ encode "hello"+    let Right result2 = decode bytes2+    assertEqual "Result not expected value" "hello?" result2+    hangup h1+    hangup h2++testGroupCall :: Assertion+testGroupCall = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+        name3 = "endpoint3"+        name4 = "endpoint4"+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    endpoint3 <- newEndpoint [transport]+    endpoint4 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    Right () <- bindEndpoint endpoint3 name3+    Right () <- bindEndpoint endpoint4 name4+    h2 <- handle endpoint2 name2 "foo" $ \bytes -> let Right msg = decode bytes in+                                                      return $ encode $ if msg == "hello" then "foo" else ""+    h3 <- handle endpoint3 name3 "foo" $ \bytes -> let Right msg = decode bytes in+                                                       return $ encode $ if msg == "hello" then "bar" else ""+    h4 <- handle endpoint4 name4 "foo" $ \bytes -> let Right msg = decode bytes in+                                                       return $ encode $ if msg == "hello" then "baz" else ""+    let cs = newCallSite endpoint1 name1+    results <- (gcall cs [name2,name3,name4] "foo" $ encode "hello")+    assertBool "Foo not present in results" (elem (encode "foo") $ M.elems results)+    assertBool "Bar not present in results" (elem (encode "bar") $ M.elems results)+    assertBool "Bar not present in results" (elem (encode "baz") $ M.elems results)+    assertEqual "Unxpected number of results" 3 (M.size results)+    hangup h2+    hangup h3+    hangup h4++testOneHandlerWithTimeout :: Assertion+testOneHandlerWithTimeout = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+        longer = 500 * 1000 -- half a second+        shorter = 250 * 1000 -- quarter second+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    -- first call with caller waiting longer than handler+    h1 <- handle endpoint2 name2 "foo" $ \bytes -> do+        let Right msg = decode bytes+        threadDelay shorter+        return $ encode $ msg ++ "!"+    let cs1 = newCallSite endpoint1 name1+    Just bytes1 <- callWithTimeout cs1 name2 "foo" longer $ encode "hello"+    let Right result1 = decode bytes1+    assertEqual "Result not expected value" (Just "hello!") (Just result1)+    hangup h1+    -- now call with handler waiting longer than caller+    h2 <- handle endpoint2 name2 "foo" $ \bytes -> do+        let Right msg = decode bytes+        threadDelay longer+        return $ encode $ msg ++ "!"+    let cs2 = newCallSite endpoint1 name1+    bytes2 <- (callWithTimeout cs2 name2 "foo" shorter $ encode "hello")+    assertEqual "Result not expected value" Nothing bytes2+    hangup h2++testGroupCallWithTimeout :: Assertion+testGroupCallWithTimeout = do+    let name1 = "endpoint1"+        name2 = "endpoint2"+        name3 = "endpoint3"+        name4 = "endpoint4"+        longest = 750 * 1000 -- three quarters of a second+        longer = 500 * 1000 -- half a second+        shorter = 250 * 1000 -- quarter second+    transport <- newMemoryTransport+    endpoint1 <- newEndpoint [transport]+    endpoint2 <- newEndpoint [transport]+    endpoint3 <- newEndpoint [transport]+    endpoint4 <- newEndpoint [transport]+    Right () <- bindEndpoint endpoint1 name1+    Right () <- bindEndpoint endpoint2 name2+    Right () <- bindEndpoint endpoint3 name3+    Right () <- bindEndpoint endpoint4 name4+    h2 <- handle endpoint2 name2 "foo" $ \bytes -> do+        let Right msg = decode bytes+        threadDelay shorter+        return $ encode $ if msg == "hello" then "foo" else ""+    h3 <- handle endpoint3 name3 "foo" $ \bytes ->  do+        threadDelay shorter+        let Right msg = decode bytes+        return $ encode $ if msg == "hello" then "bar" else ""+    h4 <- handle endpoint4 name4 "foo" $ \bytes ->  do+        threadDelay longest+        let Right msg = decode bytes+        return $ encode $ if msg == "hello" then "baz" else ""+    let cs = newCallSite endpoint1 name1+    results <- gcallWithTimeout cs [name2,name3,name4] "foo" longer $ encode "hello"+    assertEqual "Foo not present in results" (Just $ Just $ encode "foo") (M.lookup name2 results)+    assertEqual "Bar not present in results" (Just $ Just $ encode "bar") (M.lookup name3 results)+    assertEqual "Baz shouldn't be present in results" (Just $ Nothing) (M.lookup name4 results)+    assertEqual "Unxpected number of results" 3 (M.size results)+    hangup h2+    hangup h3+    hangup h4
+ tests/TestTCP.hs view
@@ -0,0 +1,54 @@+module TestTCP (tests) where++-- local imports++import Network.Endpoints+import Network.Transport.TCP++import TestTransports++-- external imports++import Control.Exception+++import Test.Framework+import Test.HUnit+import Test.Framework.Providers.HUnit+-- import Test.Framework.Providers.QuickCheck2++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++_log :: String+_log = "test.transport.tcp"++address1 :: Address+address1 = "localhost:20001"++address2 :: Address+address2 = "localhost:20002"++tests :: [Test.Framework.Test]+tests =+  [+    testCase "tcp-endpoints+transport" testEndpointTransport,+    testCase "tcp-bind-unbind" $ endpointBindUnbind _log newTCPTransport address1 address2,+    testCase "tcp-send-receive" $ endpointSendReceive _log newTCPTransport address1 address2,+    testCase "tcp-double-send-receive" $ endpointDoubleSendReceive _log newTCPTransport address1 address2,+    testCase "tcp-send-receive-reply" $ endpointSendReceiveReply _log newTCPTransport address1 address2,+    testCase "tcp-multiple-send-receive-reply" $ endpointMultipleSendReceiveReply _log newTCPTransport address1 address2,+    testCase "tcp-local-send-receive-reply" $ endpointLocalSendReceiveReply _log newTCPTransport address1 address2+  ]++testEndpointTransport :: Assertion+testEndpointTransport = do+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                               (name2,address2)]+  bracket (newTCPTransport resolver)+          shutdown+          (\transport -> do+            _ <- newEndpoint [transport]+            return ())
+ tests/TestTransports.hs view
@@ -0,0 +1,222 @@+module TestTransports (+    testDelay,+    verifiedSend,++    -- Common tests+    endpointTransport,+    endpointBindUnbind,+    endpointSendReceive,+    endpointDoubleSendReceive,+    endpointSendReceiveReply,+    endpointLocalSendReceiveReply,+    endpointMultipleSendReceiveReply+) where++-- local imports++import Network.Endpoints++-- external imports++import Control.Concurrent+import Control.Exception++import Data.Serialize++import System.Log.Logger++import Test.HUnit++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++testDelay :: Int+testDelay = 1 * 1000000++pause :: IO ()+pause = threadDelay testDelay++{-+Common tests--just supply the transport factory and 2 addresses+-}++endpointTransport :: String -> (Resolver -> IO Transport) -> Address -> Address -> Assertion+endpointTransport _log newTransport address1 address2 = do+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                               (name2,address2)]+  bracket (newTransport resolver)+          shutdown+          (\transport -> do +            _ <- newEndpoint [transport]+            return ())++endpointBindUnbind :: String -> (Resolver -> IO Transport) -> Address -> Address -> Assertion+endpointBindUnbind _log newTransport address1 address2 = do+  infoM _log "Starting bind-unbind test"+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                               (name2,address2)]+  bracket (newTransport resolver)+          shutdown+          (\transport -> do +            endpoint <- newEndpoint [transport]+            Right () <- bindEndpoint endpoint name1+            unbound <- unbindEndpoint endpoint name1+            case unbound of+              Left err -> assertFailure $ "Unbind failed: " ++ err+              Right () -> assertBool "Unbind succeeded" True+            return ())++endpointSendReceive :: String -> (Resolver -> IO Transport) -> Address -> Address -> Assertion+endpointSendReceive _log newTransport address1 address2 = do+  infoM _log "Starting send-receive test"+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                               (name2,address2)]+  bracketTest _log resolver newTransport $ \transport1 transport2 -> do +      endpoint1 <- newEndpoint [transport1]+      endpoint2 <- newEndpoint [transport2]+      Right () <- bindEndpoint endpoint1 name1+      Right () <- bindEndpoint endpoint2 name2+      pause++      verifiedSend _log endpoint1 endpoint2 name1 name2 "hello"++      Right () <- unbindEndpoint endpoint1 name1+      Right () <- unbindEndpoint endpoint2 name2+      return ()+  infoM _log "Finished send-receive test"++endpointDoubleSendReceive :: String -> (Resolver -> IO Transport) -> Address -> Address -> Assertion+endpointDoubleSendReceive _log newTransport address1 address2 = do+  infoM _log "Starting double-send-receive test"+  let name1 = "endpoint1"+      name2 = "endpoint2"+      name3 = "endpoint3"+  let resolver = resolverFromList [(name1,address1),+                               (name2,address2),+                               (name3,address1)]+  bracketTest _log resolver newTransport $ \transport1 transport2 -> do +      endpoint1 <- newEndpoint [transport1]+      endpoint2 <- newEndpoint [transport2]+      endpoint3 <- newEndpoint [transport1]+      Right () <- bindEndpoint endpoint1 name1+      Right () <- bindEndpoint endpoint2 name2+      Right () <- bindEndpoint endpoint3 name3+      pause++      verifiedSend _log endpoint1 endpoint2 name1 name2 "hello"+      verifiedSend _log endpoint3 endpoint2 name3 name2 "ciao!"++      Right () <- unbindEndpoint endpoint1 name1++      verifiedSend _log endpoint3 endpoint2 name3 name2 "hi!"++      Right () <- unbindEndpoint endpoint2 name2+      Right () <- unbindEndpoint endpoint3 name3+      return ()+  infoM _log "Finished double-send-receive test"++endpointSendReceiveReply :: String -> (Resolver -> IO Transport) -> Address -> Address -> Assertion+endpointSendReceiveReply _log newTransport address1 address2 = do+  infoM _log "Starting send-receive-reply test"+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                                   (name2,address2)]+  bracketTest _log resolver newTransport $ \transport1 transport2 -> do +      endpoint1 <- newEndpoint [transport1]+      endpoint2 <- newEndpoint [transport2]+      Right () <- bindEndpoint endpoint1 name1+      Right () <- bindEndpoint endpoint2 name2+      pause++      verifiedSend _log endpoint1 endpoint2 name1 name2 "hello"+      verifiedSend _log endpoint2 endpoint1 name2 name1 "hi!"++      Right () <- unbindEndpoint endpoint1 name1+      Right () <- unbindEndpoint endpoint2 name2++      return ()+  infoM _log "Finished send-receive-reply test"++endpointLocalSendReceiveReply :: String -> (Resolver -> IO Transport) -> Address -> Address -> Assertion+endpointLocalSendReceiveReply _log newTransport address1 _ = do+  infoM _log "Starting local-send-receive-reply test"+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                                   (name2,address1)]+  bracket (newTransport resolver)+    shutdown+    (\transport1 -> do+        endpoint1 <- newEndpoint [transport1]+        endpoint2 <- newEndpoint [transport1]+        Right () <- bindEndpoint endpoint1 name1+        Right () <- bindEndpoint endpoint2 name2+        pause++        verifiedSend _log endpoint1 endpoint2 name1 name2 "hello"+        verifiedSend _log endpoint2 endpoint1 name2 name1 "hi!"++        Right () <- unbindEndpoint endpoint1 name1+        Right () <- unbindEndpoint endpoint2 name2++        return ())+  infoM _log "Finished local-send-receive-reply test"++endpointMultipleSendReceiveReply :: String -> (Resolver -> IO Transport) -> Address -> Address -> Assertion+endpointMultipleSendReceiveReply _log newTransport address1 address2 = do+  infoM _log "Starting multiple-send-receive-reply test"+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                                   (name2,address2)]+  bracketTest _log resolver newTransport $ \transport1 transport2 -> do+      endpoint1 <- newEndpoint [transport1]+      endpoint2 <- newEndpoint [transport2]+      Right () <- bindEndpoint endpoint1 name1+      Right () <- bindEndpoint endpoint2 name2+      pause++      roundtrip endpoint1 endpoint2 name1 name2+      roundtrip endpoint2 endpoint1 name2 name1+      roundtrip endpoint1 endpoint2 name1 name2+      roundtrip endpoint2 endpoint1 name2 name1++      Right () <- unbindEndpoint endpoint1 name1+      Right () <- unbindEndpoint endpoint2 name2++      return ()+  infoM _log "Finished multiple-send-receive-reply test"+    where+      roundtrip endpoint1 endpoint2 name1 name2 = do+        verifiedSend _log endpoint1 endpoint2 name1 name2 "hello"+        verifiedSend _log endpoint2 endpoint1 name2 name1 "hi!"++-- helpers++bracketTest :: String -> Resolver -> (Resolver -> IO Transport) -> (Transport -> Transport -> Assertion) -> Assertion+bracketTest _log resolver newTransport blk = do+    bracket (newTransport resolver)+        shutdown+        (\transport1 -> +            bracket (newTransport resolver)+                shutdown+                (\transport2 -> catch (blk transport1 transport2)+                                    (\e -> do +                                        errorM _log $ "Encountered error running test: " ++ (show (e :: SomeException))+                                        assertFailure "Unexpected error")))++verifiedSend :: String -> Endpoint -> Endpoint -> Name -> Name -> String -> Assertion+verifiedSend _log endpoint1 endpoint2 name1 name2 msg = do+  infoM _log $ "Sending message from " ++ name1 ++ " to " ++ name2+  sendMessage_ endpoint1 name2 $ encode msg+  maybeMsg <- receiveMessageTimeout endpoint2 testDelay+  case maybeMsg of+    Nothing -> assertFailure "No message received"+    Just msg1 -> assertEqual "Received message not same as sent" (Right msg) (decode msg1)
+ tests/TestUDP.hs view
@@ -0,0 +1,55 @@+module TestUDP where++-- local imports++import Network.Endpoints+import Network.Transport.UDP++import TestTransports++-- external imports++import Control.Exception++import Test.Framework+import Test.HUnit+import Test.Framework.Providers.HUnit+-- import Test.Framework.Providers.QuickCheck2++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++_log :: String+_log = "test.transport.udp"++address1 :: Address+address1 = "localhost:2003"++address2 :: Address+address2 = "localhost:2004"++tests :: [Test.Framework.Test]+tests = +  [+    testCase "udp-endpoints+transport" testEndpointTransport,++    testCase "udp-bind-unbind" $ endpointBindUnbind _log newUDPTransport address1 address2,+    testCase "udp-send-receive" $ endpointSendReceive _log newUDPTransport address1 address2,+    testCase "udp-double-send-receive" $ endpointDoubleSendReceive _log newUDPTransport address1 address2,+    testCase "udp-send-receive-reply" $ endpointSendReceiveReply _log newUDPTransport address1 address2,+    testCase "udp-multiple-send-receive-reply" $ endpointMultipleSendReceiveReply _log newUDPTransport address1 address2,+    testCase "udp-local-send-receive-reply" $ endpointLocalSendReceiveReply _log newUDPTransport address1 address2+    +  ]++testEndpointTransport :: Assertion+testEndpointTransport = do+  let name1 = "endpoint1"+      name2 = "endpoint2"+  let resolver = resolverFromList [(name1,address1),+                               (name2,address2)]+  bracket (newUDPTransport resolver)+          shutdown+          (\transport -> do +            _ <- newEndpoint [transport]+            return ())