diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Message.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Message.hs | 18 |
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 | |||
92 | import Data.Typeable | 92 | import Data.Typeable |
93 | import Network | 93 | import Network |
94 | import Network.KRPC | 94 | import Network.KRPC |
95 | import Data.Maybe | ||
95 | 96 | ||
96 | import Data.Torrent | 97 | import Data.Torrent |
97 | import Network.BitTorrent.Address | 98 | import Network.BitTorrent.Address |
@@ -105,11 +106,16 @@ import Network.KRPC () | |||
105 | node_id_key :: BKey | 106 | node_id_key :: BKey |
106 | node_id_key = "id" | 107 | node_id_key = "id" |
107 | 108 | ||
109 | read_only_key :: BKey | ||
110 | read_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. |
110 | data Query a = Query | 115 | data 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 | ||
115 | instance BEncode a => BEncode (Query a) where | 121 | instance 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 | |||
135 | instance BEncode a => BEncode (Response a) where | 143 | instance 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 | {----------------------------------------------------------------------- |