diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Tracker.hs | 24 |
1 files changed, 17 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs index 9acfc53d..04a7b43e 100644 --- a/src/Network/BitTorrent/Tracker.hs +++ b/src/Network/BitTorrent/Tracker.hs | |||
@@ -21,7 +21,9 @@ module Network.BitTorrent.Tracker | |||
21 | , TConnection(..), tconnection | 21 | , TConnection(..), tconnection |
22 | 22 | ||
23 | -- * Session | 23 | -- * Session |
24 | , TSession, getPeerList, getProgress, waitInterval | 24 | , TSession |
25 | , getPeerAddr, getPeerList | ||
26 | , getProgress, waitInterval | ||
25 | 27 | ||
26 | -- * Re-export | 28 | -- * Re-export |
27 | , defaultPorts | 29 | , defaultPorts |
@@ -125,16 +127,24 @@ completedReq ses pr = (genericReq ses pr) { | |||
125 | data TSession = TSession { | 127 | data TSession = TSession { |
126 | seProgress :: TVar Progress | 128 | seProgress :: TVar Progress |
127 | , seInterval :: IORef Int | 129 | , seInterval :: IORef Int |
128 | , sePeers :: TVar [PeerAddr] | 130 | , sePeers :: Chan PeerAddr |
131 | -- TODO use something like 'TVar (Set PeerAddr)' | ||
132 | -- otherwise we might get space leak | ||
129 | } | 133 | } |
130 | 134 | ||
131 | newSession :: Progress -> Int -> [PeerAddr] -> IO TSession | 135 | newSession :: Progress -> Int -> [PeerAddr] -> IO TSession |
132 | newSession pr i ps = TSession <$> newTVarIO pr | 136 | newSession pr i ps = do |
133 | <*> newIORef i | 137 | chan <- newChan |
134 | <*> newTVarIO ps | 138 | writeList2Chan chan ps |
139 | TSession <$> newTVarIO pr | ||
140 | <*> newIORef i | ||
141 | <*> pure chan | ||
142 | |||
143 | getPeerAddr :: TSession -> IO PeerAddr | ||
144 | getPeerAddr = readChan . sePeers | ||
135 | 145 | ||
136 | getPeerList :: TSession -> IO [PeerAddr] | 146 | getPeerList :: TSession -> IO [PeerAddr] |
137 | getPeerList = readTVarIO . sePeers | 147 | getPeerList = getChanContents . sePeers |
138 | 148 | ||
139 | getProgress :: TSession -> IO Progress | 149 | getProgress :: TSession -> IO Progress |
140 | getProgress = readTVarIO . seProgress | 150 | getProgress = readTVarIO . seProgress |
@@ -159,7 +169,7 @@ withTracker initProgress conn action = bracket start end (action . fst) | |||
159 | case resp of | 169 | case resp of |
160 | Right (OK {..}) -> do | 170 | Right (OK {..}) -> do |
161 | writeIORef seInterval respInterval | 171 | writeIORef seInterval respInterval |
162 | atomically $ writeTVar sePeers respPeers | 172 | writeList2Chan sePeers respPeers |
163 | _ -> return () | 173 | _ -> return () |
164 | where | 174 | where |
165 | isIOException :: IOException -> Maybe IOException | 175 | isIOException :: IOException -> Maybe IOException |