summaryrefslogtreecommitdiff
path: root/Mainline.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Mainline.hs')
-rw-r--r--Mainline.hs21
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
52import Network.Socket 52import Network.Socket
53 53
54newtype NodeId = NodeId ByteString 54newtype NodeId = NodeId ByteString
55 deriving (Eq,Ord,Show,ByteArrayAccess, BEncode, Bits) 55 deriving (Eq,Ord,Show,ByteArrayAccess, BEncode, Bits, Hashable)
56 56
57instance FiniteBits NodeId where 57instance FiniteBits NodeId where
58 finiteBitSize _ = 160 58 finiteBitSize _ = 160
@@ -174,7 +174,7 @@ data Message a = Q { msgOrigin :: NodeId
174 174
175instance BE.BEncode (Message BValue) where 175instance BE.BEncode (Message BValue) where
176 toBEncode = encodeMessage 176 toBEncode = encodeMessage
177 fromBEncode = error "fromBEncode" 177 fromBEncode = error "TODO: fromBEncode (Mainline Message)"
178 178
179encodeMessage (Q origin tid a meth ro) 179encodeMessage (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
200encodeError tid (Error ecode emsg) = encodeAny tid "e" (ecode,emsg) id 200encodeError tid (Error ecode emsg) = encodeAny tid "e" (ecode,emsg) id
201
201encodeResponse tid rvals rip = encodeAny tid "r" rvals ("ip" .=? rip .:) 202encodeResponse tid rvals rip = encodeAny tid "r" rvals ("ip" .=? rip .:)
203
202encodeQuery tid qmeth qargs = encodeAny tid "q" qmeth ("a" .=! qargs .:) 204encodeQuery tid qmeth qargs = encodeAny tid "q" qmeth ("a" .=! qargs .:)
203 205
204encodeAny tid key val aux = toDict $ 206encodeAny 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