summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Session.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Session.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Session.hs79
1 files changed, 46 insertions, 33 deletions
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index 1537efe1..8cbce4e3 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -77,17 +77,23 @@ cache :: BEncode a => a -> Cached a
77cache s = Cached s (BE.encode s) 77cache s = Cached s (BE.encode s)
78 78
79data Session = Session 79data Session = Session
80 { tpeerId :: PeerId 80 { sessionPeerId :: !(PeerId)
81 , infohash :: InfoHash 81 , sessionTopic :: !(InfoHash)
82 , metadata :: MVar Metadata.Status 82
83 , storage :: Storage 83 , metadata :: !(MVar Metadata.Status)
84 , status :: MVar SessionStatus 84 , infodict :: !(MVar (Cached InfoDict))
85 , unchoked :: [PeerAddr IP] 85
86 , pendingConnections :: TVar (Set (PeerAddr IP)) 86 , status :: !(MVar SessionStatus)
87 , establishedConnections :: TVar (Map (PeerAddr IP) (Connection Session)) 87 , storage :: !(Storage)
88 , broadcast :: Chan Message 88
89 , logger :: LogFun 89 , broadcast :: !(Chan Message)
90 , infodict :: MVar (Cached InfoDict) 90
91 , unchoked :: [PeerAddr IP]
92 , connectionsPrefs :: !ConnectionPrefs
93 , connectionsPending :: !(TVar (Set (PeerAddr IP)))
94 , connectionsEstablished :: !(TVar (Map (PeerAddr IP) (Connection Session)))
95
96 , logger :: !(LogFun)
91 } 97 }
92 98
93instance Ord IP 99instance Ord IP
@@ -101,6 +107,7 @@ newSession :: LogFun
101 -> InfoDict -- ^ torrent info dictionary; 107 -> InfoDict -- ^ torrent info dictionary;
102 -> IO Session -- ^ 108 -> IO Session -- ^
103newSession logFun addr rootPath dict = do 109newSession logFun addr rootPath dict = do
110 pid <- maybe genPeerId return (peerId addr)
104 pconnVar <- newTVarIO S.empty 111 pconnVar <- newTVarIO S.empty
105 econnVar <- newTVarIO M.empty 112 econnVar <- newTVarIO M.empty
106 store <- openInfoDict ReadWriteEx rootPath dict 113 store <- openInfoDict ReadWriteEx rootPath dict
@@ -108,16 +115,18 @@ newSession logFun addr rootPath dict = do
108 (piPieceLength (idPieceInfo dict)) 115 (piPieceLength (idPieceInfo dict))
109 chan <- newChan 116 chan <- newChan
110 return Session 117 return Session
111 { tpeerId = fromMaybe (error "newSession: impossible") 118 { sessionPeerId = pid
112 (peerId addr) 119 , sessionTopic = idInfoHash dict
113 , infohash = idInfoHash dict
114 , status = statusVar 120 , status = statusVar
115 , storage = store 121 , storage = store
116 , unchoked = [] 122 , unchoked = []
117 , pendingConnections = pconnVar 123 , connectionsPrefs = def
118 , establishedConnections = econnVar 124 , connectionsPending = pconnVar
119 , broadcast = chan 125 , connectionsEstablished = econnVar
120 , logger = logFun 126 , broadcast = chan
127 , logger = logFun
128 , metadata = undefined
129 , infodict = undefined
121 } 130 }
122 131
123closeSession :: Session -> IO () 132closeSession :: Session -> IO ()
@@ -152,12 +161,12 @@ logEvent = logInfoN
152 161
153pendingConnection :: PeerAddr IP -> Session -> IO Bool 162pendingConnection :: PeerAddr IP -> Session -> IO Bool
154pendingConnection addr Session {..} = atomically $ do 163pendingConnection addr Session {..} = atomically $ do
155 pSet <- readTVar pendingConnections 164 pSet <- readTVar connectionsPending
156 eSet <- readTVar establishedConnections 165 eSet <- readTVar connectionsEstablished
157 if (addr `S.member` pSet) || (addr `M.member` eSet) 166 if (addr `S.member` pSet) || (addr `M.member` eSet)
158 then return False 167 then return False
159 else do 168 else do
160 modifyTVar' pendingConnections (S.insert addr) 169 modifyTVar' connectionsPending (S.insert addr)
161 return True 170 return True
162 171
163establishedConnection :: Connected Session () 172establishedConnection :: Connected Session ()
@@ -172,8 +181,8 @@ finishedConnection = return ()
172-- | There are no state for this connection, remove it. 181-- | There are no state for this connection, remove it.
173closedConnection :: PeerAddr IP -> Session -> IO () 182closedConnection :: PeerAddr IP -> Session -> IO ()
174closedConnection addr Session {..} = atomically $ do 183closedConnection addr Session {..} = atomically $ do
175 modifyTVar pendingConnections $ S.delete addr 184 modifyTVar connectionsPending $ S.delete addr
176 modifyTVar establishedConnections $ M.delete addr 185 modifyTVar connectionsEstablished $ M.delete addr
177 186
178{----------------------------------------------------------------------- 187{-----------------------------------------------------------------------
179-- Connections 188-- Connections
@@ -190,16 +199,20 @@ mainWire = do
190 lift finishedConnection 199 lift finishedConnection
191 200
192getConnectionConfig :: Session -> IO (ConnectionConfig Session) 201getConnectionConfig :: Session -> IO (ConnectionConfig Session)
193getConnectionConfig s @ Session {..} = undefined --ConnectionConfig 202getConnectionConfig s @ Session {..} = do
194-- let caps = def 203 chan <- dupChan broadcast
195-- let ecaps = def 204 let sessionLink = SessionLink {
196-- let hs = Handshake def caps infohash tpeerId 205 linkTopic = sessionTopic
197-- chan <- dupChan broadcast 206 , linkPeerId = sessionPeerId
198 207 , linkMetadataSize = Nothing
199-- { cfgPrefs = undefined 208 , linkOutputChan = Just chan
200-- , cfgSession = ConnectionSession undefined undefined s 209 , linkSession = s
201-- , cfgWire = mainWire 210 }
202-- } 211 return ConnectionConfig
212 { cfgPrefs = connectionsPrefs
213 , cfgSession = sessionLink
214 , cfgWire = mainWire
215 }
203 216
204insert :: PeerAddr IP -> Session -> IO () 217insert :: PeerAddr IP -> Session -> IO ()
205insert addr ses @ Session {..} = void $ forkIO (action `finally` cleanup) 218insert addr ses @ Session {..} = void $ forkIO (action `finally` cleanup)