summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT/Message.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/DHT/Message.hs')
-rw-r--r--src/Network/BitTorrent/DHT/Message.hs18
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
92import Data.Typeable 92import Data.Typeable
93import Network 93import Network
94import Network.KRPC 94import Network.KRPC
95import Data.Maybe
95 96
96import Data.Torrent 97import Data.Torrent
97import Network.BitTorrent.Address 98import Network.BitTorrent.Address
@@ -105,11 +106,16 @@ import Network.KRPC ()
105node_id_key :: BKey 106node_id_key :: BKey
106node_id_key = "id" 107node_id_key = "id"
107 108
109read_only_key :: BKey
110read_only_key = "ro"
111
112
108-- | All queries have an \"id\" key and value containing the node ID 113-- | All queries have an \"id\" key and value containing the node ID
109-- of the querying node. 114-- of the querying node.
110data Query a = Query 115data Query a = Query
111 { queringNodeId :: NodeId -- ^ node id of /quering/ node; 116 { queringNodeId :: NodeId -- ^ node id of /quering/ node;
112 , queryParams :: a -- ^ query parameters. 117 , queryIsReadOnly :: Bool -- ^ node is read-only as per BEP 43
118 , queryParams :: a -- ^ query parameters.
113 } deriving (Show, Eq, Typeable) 119 } deriving (Show, Eq, Typeable)
114 120
115instance BEncode a => BEncode (Query a) where 121instance BEncode a => BEncode (Query a) where
@@ -118,11 +124,13 @@ instance BEncode a => BEncode (Query a) where
118 <> 124 <>
119 dict (toBEncode queryParams) 125 dict (toBEncode queryParams)
120 where 126 where
121 dict (BDict d) = d 127 dict (BDict d) | queryIsReadOnly = Cons read_only_key (BInteger 1) d
128 | otherwise = d
122 dict _ = error "impossible: instance BEncode (Query a)" 129 dict _ = error "impossible: instance BEncode (Query a)"
123 130
124 fromBEncode v = do 131 fromBEncode v = do
125 Query <$> fromDict (field (req node_id_key)) v 132 Query <$> fromDict (field (req node_id_key)) v
133 <*> fromDict (fromMaybe False <$>? read_only_key) v
126 <*> fromBEncode v 134 <*> fromBEncode v
127 135
128-- | All responses have an \"id\" key and value containing the node ID 136-- | All responses have an \"id\" key and value containing the node ID
@@ -135,11 +143,11 @@ data Response a = Response
135instance BEncode a => BEncode (Response a) where 143instance BEncode a => BEncode (Response a) where
136 toBEncode = toBEncode . toQuery 144 toBEncode = toBEncode . toQuery
137 where 145 where
138 toQuery (Response nid a) = Query nid a 146 toQuery (Response nid a) = Query nid False a
139 147
140 fromBEncode b = fromQuery <$> fromBEncode b 148 fromBEncode b = fromQuery <$> fromBEncode b
141 where 149 where
142 fromQuery (Query nid a) = Response nid a 150 fromQuery (Query nid _ a) = Response nid a
143 151
144 152
145{----------------------------------------------------------------------- 153{-----------------------------------------------------------------------