Don't use BEP 43 read-only nodes for routing.

1 files changed, 13 insertions, 5 deletions

diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
index 008145de..b8f272c3 100644
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ b/src/Network/BitTorrent/DHT/Message.hs
@@ -92,6 +92,7 @@ import Data.Serialize as S
 import Data.Typeable
 import Network
 import Network.KRPC
+import Data.Maybe
 
 import Data.Torrent
 import Network.BitTorrent.Address
@@ -105,11 +106,16 @@ import Network.KRPC ()
 node_id_key :: BKey
 node_id_key = "id"
 
+read_only_key :: BKey
+read_only_key = "ro"
+
+
 -- | All queries have an \"id\" key and value containing the node ID
 -- of the querying node.
 data Query a = Query
-  { queringNodeId :: NodeId -- ^ node id of /quering/ node;
-  , queryParams   :: a      -- ^ query parameters.
+  { queringNodeId   :: NodeId -- ^ node id of /quering/ node;
+  , queryIsReadOnly :: Bool   -- ^ node is read-only as per BEP 43
+  , queryParams     :: a      -- ^ query parameters.
   } deriving (Show, Eq, Typeable)
 
 instance BEncode a => BEncode (Query a) where
@@ -118,11 +124,13 @@ instance BEncode a => BEncode (Query a) where
       <>
       dict (toBEncode queryParams)
     where
-      dict (BDict d) = d
+      dict (BDict d) | queryIsReadOnly = Cons read_only_key (BInteger 1) d
+                     | otherwise       = d
       dict    _      = error "impossible: instance BEncode (Query a)"
 
   fromBEncode v = do
     Query <$> fromDict (field (req node_id_key)) v
+          <*> fromDict (fromMaybe False <$>? read_only_key) v
           <*> fromBEncode v
 
 -- | All responses have an \"id\" key and value containing the node ID
@@ -135,11 +143,11 @@ data Response a = Response
 instance BEncode a => BEncode (Response a) where
   toBEncode = toBEncode . toQuery
     where
-      toQuery (Response nid a) = Query nid a
+      toQuery (Response nid a) = Query nid False a
 
   fromBEncode b = fromQuery <$> fromBEncode b
     where
-      fromQuery (Query nid a) = Response nid a
+      fromQuery (Query nid _ a) = Response nid a
 
 
 {-----------------------------------------------------------------------