diff options
Diffstat (limited to 'Mainline.hs')
-rw-r--r-- | Mainline.hs | 21 |
1 files changed, 17 insertions, 4 deletions
diff --git a/Mainline.hs b/Mainline.hs index 17fb32ee..80834922 100644 --- a/Mainline.hs +++ b/Mainline.hs | |||
@@ -52,7 +52,7 @@ import Network.QueryResponse | |||
52 | import Network.Socket | 52 | import Network.Socket |
53 | 53 | ||
54 | newtype NodeId = NodeId ByteString | 54 | newtype NodeId = NodeId ByteString |
55 | deriving (Eq,Ord,Show,ByteArrayAccess, BEncode, Bits) | 55 | deriving (Eq,Ord,Show,ByteArrayAccess, BEncode, Bits, Hashable) |
56 | 56 | ||
57 | instance FiniteBits NodeId where | 57 | instance FiniteBits NodeId where |
58 | finiteBitSize _ = 160 | 58 | finiteBitSize _ = 160 |
@@ -174,7 +174,7 @@ data Message a = Q { msgOrigin :: NodeId | |||
174 | 174 | ||
175 | instance BE.BEncode (Message BValue) where | 175 | instance BE.BEncode (Message BValue) where |
176 | toBEncode = encodeMessage | 176 | toBEncode = encodeMessage |
177 | fromBEncode = error "fromBEncode" | 177 | fromBEncode = error "TODO: fromBEncode (Mainline Message)" |
178 | 178 | ||
179 | encodeMessage (Q origin tid a meth ro) | 179 | encodeMessage (Q origin tid a meth ro) |
180 | = case a of | 180 | = case a of |
@@ -198,7 +198,9 @@ genericArgs nodeid ro = | |||
198 | .: endDict | 198 | .: endDict |
199 | 199 | ||
200 | encodeError tid (Error ecode emsg) = encodeAny tid "e" (ecode,emsg) id | 200 | encodeError tid (Error ecode emsg) = encodeAny tid "e" (ecode,emsg) id |
201 | |||
201 | encodeResponse tid rvals rip = encodeAny tid "r" rvals ("ip" .=? rip .:) | 202 | encodeResponse tid rvals rip = encodeAny tid "r" rvals ("ip" .=? rip .:) |
203 | |||
202 | encodeQuery tid qmeth qargs = encodeAny tid "q" qmeth ("a" .=! qargs .:) | 204 | encodeQuery tid qmeth qargs = encodeAny tid "q" qmeth ("a" .=! qargs .:) |
203 | 205 | ||
204 | encodeAny tid key val aux = toDict $ | 206 | encodeAny tid key val aux = toDict $ |
@@ -286,8 +288,8 @@ newClient addr = do | |||
286 | } | 288 | } |
287 | routing <- atomically $ do | 289 | routing <- atomically $ do |
288 | let nobkts = R.defaultBucketCount :: Int | 290 | let nobkts = R.defaultBucketCount :: Int |
289 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts | 291 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts |
290 | tbl6 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts | 292 | tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts |
291 | committee4 <- newTriadCommittee (const $ return ()) -- TODO: update tbl4 | 293 | committee4 <- newTriadCommittee (const $ return ()) -- TODO: update tbl4 |
292 | committee6 <- newTriadCommittee (const $ return ()) -- TODO: update tbl6 | 294 | committee6 <- newTriadCommittee (const $ return ()) -- TODO: update tbl6 |
293 | return $ Routing tenative_info tbl4 committee4 tbl6 committee6 | 295 | return $ Routing tenative_info tbl4 committee4 tbl6 committee6 |
@@ -518,6 +520,17 @@ instance BEncode GotPeers where | |||
518 | fromBEncode = fromDict $ do | 520 | fromBEncode = fromDict $ do |
519 | ns4 <- fromMaybe [] <$> optional (binary getNodeInfo4 nodes_key) -- "nodes" | 521 | ns4 <- fromMaybe [] <$> optional (binary getNodeInfo4 nodes_key) -- "nodes" |
520 | ns6 <- fromMaybe [] <$> optional (binary getNodeInfo6 nodes6_key) -- "nodes6" | 522 | ns6 <- fromMaybe [] <$> optional (binary getNodeInfo6 nodes6_key) -- "nodes6" |
523 | -- TODO: BEP 42... | ||
524 | -- | ||
525 | -- Once enforced, responses to get_peers requests whose node ID does not | ||
526 | -- match its external IP should be considered to not contain a token and | ||
527 | -- thus not be eligible as storage target. Implementations should take | ||
528 | -- care that they find the closest set of nodes which return a token and | ||
529 | -- whose IDs matches their IPs before sending a store request to those | ||
530 | -- nodes. | ||
531 | -- | ||
532 | -- Sounds like something to take care of at peer-search time, so I'll | ||
533 | -- ignore it for now. | ||
521 | tok <- field (req token_key) -- "token" | 534 | tok <- field (req token_key) -- "token" |
522 | ps <- fromMaybe [] <$> optional (field (req peers_key) >>= decodePeers) -- "values" | 535 | ps <- fromMaybe [] <$> optional (field (req peers_key) >>= decodePeers) -- "values" |
523 | pure $ GotPeers ps (NodeFound ns4 ns6) tok | 536 | pure $ GotPeers ps (NodeFound ns4 ns6) tok |