diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r-- | src/Network/BitTorrent/Tracker/UDP.hs | 45 |
1 files changed, 22 insertions, 23 deletions
diff --git a/src/Network/BitTorrent/Tracker/UDP.hs b/src/Network/BitTorrent/Tracker/UDP.hs index 645be359..7d413a9c 100644 --- a/src/Network/BitTorrent/Tracker/UDP.hs +++ b/src/Network/BitTorrent/Tracker/UDP.hs | |||
@@ -55,30 +55,29 @@ genToken = do | |||
55 | where | 55 | where |
56 | err = error "genToken: impossible happen" | 56 | err = error "genToken: impossible happen" |
57 | 57 | ||
58 | -- TODO rename | ||
59 | -- | Connection Id is used for entire tracker session. | 58 | -- | Connection Id is used for entire tracker session. |
60 | newtype ConnId = ConnId Word64 | 59 | newtype ConnectionId = ConnectionId Word64 |
61 | deriving (Eq, Serialize) | 60 | deriving (Eq, Serialize) |
62 | 61 | ||
63 | instance Show ConnId where | 62 | instance Show ConnectionId where |
64 | showsPrec _ (ConnId cid) = showString "0x" <> showHex cid | 63 | showsPrec _ (ConnectionId cid) = showString "0x" <> showHex cid |
65 | 64 | ||
66 | genConnectionId :: IO ConnId | 65 | genConnectionId :: IO ConnectionId |
67 | genConnectionId = ConnId <$> genToken | 66 | genConnectionId = ConnectionId <$> genToken |
68 | 67 | ||
69 | initialConnectionId :: ConnId | 68 | initialConnectionId :: ConnectionId |
70 | initialConnectionId = ConnId 0x41727101980 | 69 | initialConnectionId = ConnectionId 0x41727101980 |
71 | 70 | ||
72 | -- TODO rename | 71 | -- TODO rename |
73 | -- | Transaction Id is used within a UDP RPC. | 72 | -- | Transaction Id is used within a UDP RPC. |
74 | newtype TransId = TransId Word32 | 73 | newtype TransactionId = TransactionId Word32 |
75 | deriving (Eq, Serialize) | 74 | deriving (Eq, Serialize) |
76 | 75 | ||
77 | instance Show TransId where | 76 | instance Show TransactionId where |
78 | showsPrec _ (TransId tid) = showString "0x" <> showHex tid | 77 | showsPrec _ (TransactionId tid) = showString "0x" <> showHex tid |
79 | 78 | ||
80 | genTransactionId :: IO TransId | 79 | genTransactionId :: IO TransactionId |
81 | genTransactionId = (TransId . fromIntegral) <$> genToken | 80 | genTransactionId = (TransactionId . fromIntegral) <$> genToken |
82 | 81 | ||
83 | {----------------------------------------------------------------------- | 82 | {----------------------------------------------------------------------- |
84 | Transactions | 83 | Transactions |
@@ -89,7 +88,7 @@ data Request = Connect | |||
89 | | Scrape ScrapeQuery | 88 | | Scrape ScrapeQuery |
90 | deriving Show | 89 | deriving Show |
91 | 90 | ||
92 | data Response = Connected ConnId | 91 | data Response = Connected ConnectionId |
93 | | Announced AnnounceInfo | 92 | | Announced AnnounceInfo |
94 | | Scraped [ScrapeInfo] | 93 | | Scraped [ScrapeInfo] |
95 | | Failed Text | 94 | | Failed Text |
@@ -97,12 +96,12 @@ data Response = Connected ConnId | |||
97 | 96 | ||
98 | data family Transaction a | 97 | data family Transaction a |
99 | data instance Transaction Request = TransactionQ | 98 | data instance Transaction Request = TransactionQ |
100 | { connIdQ :: {-# UNPACK #-} !ConnId | 99 | { connIdQ :: {-# UNPACK #-} !ConnectionId |
101 | , transIdQ :: {-# UNPACK #-} !TransId | 100 | , transIdQ :: {-# UNPACK #-} !TransactionId |
102 | , request :: !Request | 101 | , request :: !Request |
103 | } deriving Show | 102 | } deriving Show |
104 | data instance Transaction Response = TransactionR | 103 | data instance Transaction Response = TransactionR |
105 | { transIdR :: {-# UNPACK #-} !TransId | 104 | { transIdR :: {-# UNPACK #-} !TransactionId |
106 | , response :: !Response | 105 | , response :: !Response |
107 | } deriving Show | 106 | } deriving Show |
108 | 107 | ||
@@ -199,7 +198,7 @@ connectionLifetimeServer :: NominalDiffTime | |||
199 | connectionLifetimeServer = 120 | 198 | connectionLifetimeServer = 120 |
200 | 199 | ||
201 | data Connection = Connection | 200 | data Connection = Connection |
202 | { connectionId :: ConnId | 201 | { connectionId :: ConnectionId |
203 | , connectionTimestamp :: UTCTime | 202 | , connectionTimestamp :: UTCTime |
204 | } deriving Show | 203 | } deriving Show |
205 | 204 | ||
@@ -251,12 +250,12 @@ data UDPTracker = UDPTracker | |||
251 | , trackerConnection :: IORef Connection | 250 | , trackerConnection :: IORef Connection |
252 | } | 251 | } |
253 | 252 | ||
254 | updateConnection :: ConnId -> UDPTracker -> IO () | 253 | updateConnection :: ConnectionId -> UDPTracker -> IO () |
255 | updateConnection cid UDPTracker {..} = do | 254 | updateConnection cid UDPTracker {..} = do |
256 | newConnection <- Connection cid <$> getCurrentTime | 255 | newConnection <- Connection cid <$> getCurrentTime |
257 | writeIORef trackerConnection newConnection | 256 | writeIORef trackerConnection newConnection |
258 | 257 | ||
259 | getConnectionId :: UDPTracker -> IO ConnId | 258 | getConnectionId :: UDPTracker -> IO ConnectionId |
260 | getConnectionId UDPTracker {..} | 259 | getConnectionId UDPTracker {..} |
261 | = connectionId <$> readIORef trackerConnection | 260 | = connectionId <$> readIORef trackerConnection |
262 | 261 | ||
@@ -279,7 +278,7 @@ transaction tracker @ UDPTracker {..} request = do | |||
279 | | otherwise -> throwIO $ userError "transaction id mismatch" | 278 | | otherwise -> throwIO $ userError "transaction id mismatch" |
280 | Left msg -> throwIO $ userError msg | 279 | Left msg -> throwIO $ userError msg |
281 | 280 | ||
282 | connectUDP :: UDPTracker -> IO ConnId | 281 | connectUDP :: UDPTracker -> IO ConnectionId |
283 | connectUDP tracker = do | 282 | connectUDP tracker = do |
284 | TransactionR tid resp <- transaction tracker Connect | 283 | TransactionR tid resp <- transaction tracker Connect |
285 | case resp of | 284 | case resp of |