@@ -6,9 +6,10 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
66import Control.Applicative ((<$>))
77import Control.Category ((>>>))
88import Control.Concurrent.MVar (MVar, newMVar, modifyMVar, modifyMVar_, readMVar)
9−import Control.Monad (forM_)
9+import Control.Monad (forM_, when)
1010import Data.Map (Map)
1111import qualified Data.Map as Map (empty, insert, size, delete, findWithDefault)
12+import Data.ByteString (ByteString)
1213import qualified Data.ByteString.Char8 as BSC (pack)
1314import Data.Lens.Lazy (Lens, lens, (^.), (^%=), (^=), (^+=), mapLens)
1415
@@ -49,45 +50,61 @@ createTransport = do
4950 , _nextConnectionId = Map.empty
5051 , _multigroups = Map.empty
5152 }
52− return Transport { newEndPoint = chanNewEndPoint state }
53+ return Transport { newEndPoint = apiNewEndPoint state }
5354
54−-- Create a new end point
55−chanNewEndPoint :: MVar TransportState -> IO (Either (FailedWith NewEndPointErrorCode) EndPoint)
56−chanNewEndPoint state = do
55+-- | Create a new end point
56+apiNewEndPoint :: MVar TransportState -> IO (Either (FailedWith NewEndPointErrorCode) EndPoint)
57+apiNewEndPoint state = do
5758 chan <- newChan
5859 addr <- modifyMVar state $ \st -> do
5960 let addr = EndPointAddress . BSC.pack . show . Map.size $ st ^. channels
6061 return ((channelAt addr ^= chan) . (nextConnectionIdAt addr ^= 1) $ st, addr)
6162 return . Right $ EndPoint { receive = readChan chan
6263 , address = addr
63− , connect = chanConnect addr state
64− , newMulticastGroup = chanNewMulticastGroup state chan
65− , resolveMulticastGroup = chanResolveMulticastGroup state chan
64+ , connect = apiConnect addr state
65+ , newMulticastGroup = apiNewMulticastGroup state chan
66+ , resolveMulticastGroup = apiResolveMulticastGroup state chan
6667 }
6768
68−-- Create a new connection
69−chanConnect :: EndPointAddress -> MVar TransportState -> EndPointAddress -> Reliability -> IO (Either (FailedWith ConnectErrorCode) Connection)
70−chanConnect myAddress state theirAddress _ = do
69+-- | Create a new connection
70+apiConnect :: EndPointAddress -> MVar TransportState -> EndPointAddress -> Reliability -> IO (Either (FailedWith ConnectErrorCode) Connection)
71+apiConnect myAddress state theirAddress _ = do
7172 (chan, conn) <- modifyMVar state $ \st -> do
7273 let chan = st ^. channelAt theirAddress
7374 let conn = st ^. nextConnectionIdAt theirAddress
7475 return (nextConnectionIdAt theirAddress ^+= 1 $ st, (chan, conn))
7576 writeChan chan $ ConnectionOpened conn ReliableOrdered myAddress
76− return . Right $ Connection { send = \msg -> do writeChan chan (Received conn msg)
77− return (Right ())
78− , close = writeChan chan $ ConnectionClosed conn
77+ connAlive <- newMVar True
78+ return . Right $ Connection { send = apiSend chan conn connAlive
79+ , close = apiClose chan conn connAlive
7980 }
8081
81−-- Create a new multicast group
82−chanNewMulticastGroup :: MVar TransportState -> Chan Event -> IO (Either (FailedWith NewMulticastGroupErrorCode) MulticastGroup)
83−chanNewMulticastGroup state endpoint = do
82+-- | Send a message over a connection
83+apiSend :: Chan Event -> ConnectionId -> MVar Bool -> [ByteString] -> IO (Either (FailedWith SendErrorCode) ())
84+apiSend chan conn connAlive msg =
85+ modifyMVar connAlive $ \alive -> do
86+ if alive
87+ then do writeChan chan (Received conn msg)
88+ return (alive, Right ())
89+ else do return (alive, Left (FailedWith SendConnectionClosed "Connection closed"))
90+
91+-- | Close a connection
92+apiClose :: Chan Event -> ConnectionId -> MVar Bool -> IO ()
93+apiClose chan conn connAlive =
94+ modifyMVar_ connAlive $ \alive -> do
95+ when alive . writeChan chan $ ConnectionClosed conn
96+ return False
97+
98+-- | Create a new multicast group
99+apiNewMulticastGroup :: MVar TransportState -> Chan Event -> IO (Either (FailedWith NewMulticastGroupErrorCode) MulticastGroup)
100+apiNewMulticastGroup state endpoint = do
84101 group <- newMVar []
85102 addr <- modifyMVar state $ \st -> do
86103 let addr = MulticastAddress . BSC.pack . show . Map.size $ st ^. multigroups
87104 return (multigroupAt addr ^= group $ st, addr)
88− return . Right $ chanMulticastGroup state endpoint addr group
105+ return . Right $ createMulticastGroup state endpoint addr group
89106
90−-- Construct a multicast group
107+-- | Construct a multicast group
91108--
92109-- When the group is deleted some endpoints may still receive messages, but
93110-- subsequent calls to resolveMulticastGroup will fail. This mimicks the fact
@@ -97,8 +114,8 @@ chanNewMulticastGroup state endpoint = do
97114-- TODO: subscribing twice means you will receive messages twice, but as soon
98115-- as you unsubscribe you will stop receiving all messages. Not sure if this
99116-- is the right behaviour.
100−chanMulticastGroup :: MVar TransportState -> Chan Event -> MulticastAddress -> MVar [Chan Event] -> MulticastGroup
101−chanMulticastGroup state endpoint addr group =
117+createMulticastGroup :: MVar TransportState -> Chan Event -> MulticastAddress -> MVar [Chan Event] -> MulticastGroup
118+createMulticastGroup state endpoint addr group =
102119 MulticastGroup { multicastAddress = addr
103120 , deleteMulticastGroup = modifyMVar_ state $ return . (multigroups ^%= Map.delete addr)
104121 , maxMsgSize = Nothing
@@ -110,13 +127,13 @@ chanMulticastGroup state endpoint addr group =
110127 , multicastClose = return ()
111128 }
112129
113−-- Resolve a multicast group
114−chanResolveMulticastGroup :: MVar TransportState
130+-- | Resolve a multicast group
131+apiResolveMulticastGroup :: MVar TransportState
115132 -> Chan Event
116133 -> MulticastAddress
117134 -> IO (Either (FailedWith ResolveMulticastGroupErrorCode) MulticastGroup)
118−chanResolveMulticastGroup state endpoint addr = do
135+apiResolveMulticastGroup state endpoint addr = do
119136 group <- (^. (multigroups >>> mapLens addr)) <$> readMVar state
120137 case group of
121138 Nothing -> return . Left $ FailedWith ResolveMulticastGroupNotFound ("Group " ++ show addr ++ " not found")
122− Just mvar -> return . Right $ chanMulticastGroup state endpoint addr mvar
139+ Just mvar -> return . Right $ createMulticastGroup state endpoint addr mvar