@@ -0,0 +1,49 @@
1+-- | Implementation of the Transport which creates a single Chan for every endpoint.
2+module Network.Transport.Chan (createTransport) where
3+
4+import Network.Transport
5+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
6+import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar)
7+import Data.Map (Map)
8+import qualified Data.Map as Map (empty, insert, (!), member)
9+
10+-- Global state: mapping from endpoint identities to the number of the next available connection
11+type TransportState = Map Identity Int
12+
13+-- | Create a new Transport
14+createTransport :: IO Transport
15+createTransport = do
16+ endpoints <- newMVar Map.empty
17+ return Transport { newEndPoint = chanNewEndPoint endpoints }
18+
19+-- Create a new end point
20+chanNewEndPoint :: MVar TransportState -> Identity -> IO (Either Error EndPoint)
21+chanNewEndPoint endpoints identity = do
22+ state <- takeMVar endpoints
23+ if identity `Map.member` state
24+ then do
25+ putMVar endpoints state
26+ return . Left $ Error undefined ("Identifier " ++ show identity ++ " already used")
27+ else do
28+ putMVar endpoints (Map.insert identity 0 state)
29+ chan <- newChan
30+ return . Right $ EndPoint { receive = readChan chan
31+ , address = Address identity
32+ , connect = chanConnect chan endpoints
33+ , multicastNewGroup = undefined
34+ , multicastConnect = undefined
35+ , multicastSubscribe = undefined
36+ , multicastUnsubscribe = undefined
37+ }
38+
39+-- Create a new connection
40+chanConnect :: Chan Event -> MVar TransportState -> Address -> Reliability -> IO (Either Error Connection)
41+chanConnect chan endpoints (Address identity) _ = do
42+ state <- takeMVar endpoints
43+ let conn = state Map.! identity
44+ putMVar endpoints (Map.insert identity (conn + 1) state)
45+ writeChan chan $ ConnectionOpened conn ReliableOrdered
46+ return . Right $ Connection { connId = conn
47+ , send = writeChan chan . Receive conn
48+ , close = writeChan chan $ ConnectionClosed conn
49+ }