diff options
Diffstat (limited to 'src/Network/KRPC/Message.hs')
-rw-r--r-- | src/Network/KRPC/Message.hs | 75 |
1 files changed, 68 insertions, 7 deletions
diff --git a/src/Network/KRPC/Message.hs b/src/Network/KRPC/Message.hs index 6f4ae620..d48fa8ac 100644 --- a/src/Network/KRPC/Message.hs +++ b/src/Network/KRPC/Message.hs | |||
@@ -12,8 +12,10 @@ | |||
12 | -- | 12 | -- |
13 | -- See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol> | 13 | -- See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol> |
14 | -- | 14 | -- |
15 | {-# LANGUAGE CPP #-} | ||
15 | {-# LANGUAGE OverloadedStrings #-} | 16 | {-# LANGUAGE OverloadedStrings #-} |
16 | {-# LANGUAGE FlexibleContexts #-} | 17 | {-# LANGUAGE FlexibleContexts #-} |
18 | {-# LANGUAGE FlexibleInstances #-} | ||
17 | {-# LANGUAGE TypeSynonymInstances #-} | 19 | {-# LANGUAGE TypeSynonymInstances #-} |
18 | {-# LANGUAGE MultiParamTypeClasses #-} | 20 | {-# LANGUAGE MultiParamTypeClasses #-} |
19 | {-# LANGUAGE FunctionalDependencies #-} | 21 | {-# LANGUAGE FunctionalDependencies #-} |
@@ -31,6 +33,11 @@ module Network.KRPC.Message | |||
31 | 33 | ||
32 | -- * Query | 34 | -- * Query |
33 | , KQuery(..) | 35 | , KQuery(..) |
36 | #ifndef VERSION_bencoding | ||
37 | , queryArgs | ||
38 | , queryMethod | ||
39 | , queryId | ||
40 | #endif | ||
34 | , MethodName | 41 | , MethodName |
35 | 42 | ||
36 | -- * Response | 43 | -- * Response |
@@ -39,12 +46,18 @@ module Network.KRPC.Message | |||
39 | 46 | ||
40 | -- * Message | 47 | -- * Message |
41 | , KMessage (..) | 48 | , KMessage (..) |
49 | , KQueryArgs | ||
50 | |||
42 | ) where | 51 | ) where |
43 | 52 | ||
44 | import Control.Applicative | 53 | import Control.Applicative |
45 | import Control.Arrow | 54 | import Control.Arrow |
46 | import Control.Exception.Lifted as Lifted | 55 | import Control.Exception.Lifted as Lifted |
56 | #ifdef VERSION_bencoding | ||
47 | import Data.BEncode as BE | 57 | import Data.BEncode as BE |
58 | #else | ||
59 | import qualified Data.Tox as Tox | ||
60 | #endif | ||
48 | import Data.ByteString as B | 61 | import Data.ByteString as B |
49 | import Data.ByteString.Char8 as BC | 62 | import Data.ByteString.Char8 as BC |
50 | import qualified Data.Serialize as S | 63 | import qualified Data.Serialize as S |
@@ -53,15 +66,23 @@ import Data.Typeable | |||
53 | import Network.Socket (SockAddr (..),PortNumber,HostAddress) | 66 | import Network.Socket (SockAddr (..),PortNumber,HostAddress) |
54 | 67 | ||
55 | 68 | ||
69 | #ifdef VERSION_bencoding | ||
56 | -- | This transaction ID is generated by the querying node and is | 70 | -- | This transaction ID is generated by the querying node and is |
57 | -- echoed in the response, so responses may be correlated with | 71 | -- echoed in the response, so responses may be correlated with |
58 | -- multiple queries to the same node. The transaction ID should be | 72 | -- multiple queries to the same node. The transaction ID should be |
59 | -- encoded as a short string of binary numbers, typically 2 characters | 73 | -- encoded as a short string of binary numbers, typically 2 characters |
60 | -- are enough as they cover 2^16 outstanding queries. | 74 | -- are enough as they cover 2^16 outstanding queries. |
61 | type TransactionId = ByteString | 75 | type TransactionId = ByteString |
76 | #else | ||
77 | type TransactionId = Tox.Nonce24 -- msgNonce | ||
78 | #endif | ||
62 | 79 | ||
63 | unknownTransaction :: TransactionId | 80 | unknownTransaction :: TransactionId |
81 | #ifdef VERSION_bencoding | ||
64 | unknownTransaction = "" | 82 | unknownTransaction = "" |
83 | #else | ||
84 | unknownTransaction = 0 | ||
85 | #endif | ||
65 | 86 | ||
66 | {----------------------------------------------------------------------- | 87 | {----------------------------------------------------------------------- |
67 | -- Error messages | 88 | -- Error messages |
@@ -98,13 +119,16 @@ instance Enum ErrorCode where | |||
98 | toEnum _ = GenericError | 119 | toEnum _ = GenericError |
99 | {-# INLINE toEnum #-} | 120 | {-# INLINE toEnum #-} |
100 | 121 | ||
122 | #ifdef VERSION_bencoding | ||
101 | instance BEncode ErrorCode where | 123 | instance BEncode ErrorCode where |
102 | toBEncode = toBEncode . fromEnum | 124 | toBEncode = toBEncode . fromEnum |
103 | {-# INLINE toBEncode #-} | 125 | {-# INLINE toBEncode #-} |
104 | 126 | ||
105 | fromBEncode b = toEnum <$> fromBEncode b | 127 | fromBEncode b = toEnum <$> fromBEncode b |
106 | {-# INLINE fromBEncode #-} | 128 | {-# INLINE fromBEncode #-} |
129 | #endif | ||
107 | 130 | ||
131 | #ifdef VERSION_bencoding | ||
108 | -- | Errors are sent when a query cannot be fulfilled. Error message | 132 | -- | Errors are sent when a query cannot be fulfilled. Error message |
109 | -- can be send only from server to client but not in the opposite | 133 | -- can be send only from server to client but not in the opposite |
110 | -- direction. | 134 | -- direction. |
@@ -113,7 +137,10 @@ data KError = KError | |||
113 | { errorCode :: !ErrorCode -- ^ the type of error; | 137 | { errorCode :: !ErrorCode -- ^ the type of error; |
114 | , errorMessage :: !ByteString -- ^ human-readable text message; | 138 | , errorMessage :: !ByteString -- ^ human-readable text message; |
115 | , errorId :: !TransactionId -- ^ match to the corresponding 'queryId'. | 139 | , errorId :: !TransactionId -- ^ match to the corresponding 'queryId'. |
116 | } deriving (Show, Read, Eq, Ord, Typeable) | 140 | } deriving ( Show, Eq, Ord, Typeable, Read ) |
141 | #else | ||
142 | type KError = Tox.Message ByteString -- TODO TOX unused | ||
143 | #endif | ||
117 | 144 | ||
118 | -- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\", | 145 | -- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\", |
119 | -- contain one additional key \"e\". The value of \"e\" is a | 146 | -- contain one additional key \"e\". The value of \"e\" is a |
@@ -129,6 +156,7 @@ data KError = KError | |||
129 | -- | 156 | -- |
130 | -- > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee | 157 | -- > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee |
131 | -- | 158 | -- |
159 | #ifdef VERSION_bencoding | ||
132 | instance BEncode KError where | 160 | instance BEncode KError where |
133 | toBEncode KError {..} = toDict $ | 161 | toBEncode KError {..} = toDict $ |
134 | "e" .=! (errorCode, errorMessage) | 162 | "e" .=! (errorCode, errorMessage) |
@@ -142,33 +170,49 @@ instance BEncode KError where | |||
142 | (code, msg) <- field (req "e") | 170 | (code, msg) <- field (req "e") |
143 | KError code msg <$>! "t" | 171 | KError code msg <$>! "t" |
144 | {-# INLINE fromBEncode #-} | 172 | {-# INLINE fromBEncode #-} |
173 | #endif | ||
145 | 174 | ||
146 | instance Exception KError | 175 | instance Exception KError |
147 | 176 | ||
148 | -- | Received 'queryArgs' or 'respVals' can not be decoded. | 177 | -- | Received 'queryArgs' or 'respVals' can not be decoded. |
149 | decodeError :: String -> TransactionId -> KError | 178 | decodeError :: String -> TransactionId -> KError |
179 | #ifdef VERSION_bencoding | ||
150 | decodeError msg = KError ProtocolError (BC.pack msg) | 180 | decodeError msg = KError ProtocolError (BC.pack msg) |
181 | #else | ||
182 | decodeError msg = error "TODO TOX Error packet" | ||
183 | #endif | ||
151 | 184 | ||
152 | -- | A remote node has send some 'KMessage' this node is unable to | 185 | -- | A remote node has send some 'KMessage' this node is unable to |
153 | -- decode. | 186 | -- decode. |
154 | unknownMessage :: String -> KError | 187 | unknownMessage :: String -> KError |
188 | #ifdef VERSION_bencoding | ||
155 | unknownMessage msg = KError ProtocolError (BC.pack msg) unknownTransaction | 189 | unknownMessage msg = KError ProtocolError (BC.pack msg) unknownTransaction |
190 | #else | ||
191 | unknownMessage msg = error "TODO TOX Protocol error" | ||
192 | #endif | ||
156 | 193 | ||
157 | {----------------------------------------------------------------------- | 194 | {----------------------------------------------------------------------- |
158 | -- Query messages | 195 | -- Query messages |
159 | -----------------------------------------------------------------------} | 196 | -----------------------------------------------------------------------} |
160 | 197 | ||
198 | #ifdef VERSION_bencoding | ||
161 | type MethodName = ByteString | 199 | type MethodName = ByteString |
200 | type KQueryArgs = BValue | ||
201 | #else | ||
202 | type MethodName = Tox.MessageType -- msgType | ||
203 | type KQueryArgs = ByteString -- msgPayload | ||
204 | #endif | ||
162 | 205 | ||
206 | #ifdef VERSION_bencoding | ||
163 | -- | Query used to signal that caller want to make procedure call to | 207 | -- | Query used to signal that caller want to make procedure call to |
164 | -- callee and pass arguments in. Therefore query may be only sent from | 208 | -- callee and pass arguments in. Therefore query may be only sent from |
165 | -- client to server but not in the opposite direction. | 209 | -- client to server but not in the opposite direction. |
166 | -- | 210 | -- |
167 | data KQuery = KQuery | 211 | data KQuery = KQuery |
168 | { queryArgs :: !BValue -- ^ values to be passed to method; | 212 | { queryArgs :: !KQueryArgs -- ^ values to be passed to method; |
169 | , queryMethod :: !MethodName -- ^ method to call; | 213 | , queryMethod :: !MethodName -- ^ method to call; |
170 | , queryId :: !TransactionId -- ^ one-time query token. | 214 | , queryId :: !TransactionId -- ^ one-time query token. |
171 | } deriving (Show, Read, Eq, Ord, Typeable) | 215 | } deriving ( Show, Eq, Ord, Typeable, Read ) |
172 | 216 | ||
173 | -- | Queries, or KRPC message dictionaries with a \"y\" value of | 217 | -- | Queries, or KRPC message dictionaries with a \"y\" value of |
174 | -- \"q\", contain two additional keys; \"q\" and \"a\". Key \"q\" has | 218 | -- \"q\", contain two additional keys; \"q\" and \"a\". Key \"q\" has |
@@ -193,13 +237,19 @@ instance BEncode KQuery where | |||
193 | KQuery <$>! "a" <*>! "q" <*>! "t" | 237 | KQuery <$>! "a" <*>! "q" <*>! "t" |
194 | {-# INLINE fromBEncode #-} | 238 | {-# INLINE fromBEncode #-} |
195 | 239 | ||
196 | newtype ReflectedIP = ReflectedIP SockAddr | ||
197 | deriving (Eq, Ord, Show) | ||
198 | |||
199 | instance BEncode ReflectedIP where | 240 | instance BEncode ReflectedIP where |
200 | toBEncode (ReflectedIP addr) = BString (encodeAddr addr) | 241 | toBEncode (ReflectedIP addr) = BString (encodeAddr addr) |
201 | fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs | 242 | fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs |
202 | fromBEncode _ = Left "ReflectedIP should be a bencoded string" | 243 | fromBEncode _ = Left "ReflectedIP should be a bencoded string" |
244 | #else | ||
245 | type KQuery = Tox.Message KQueryArgs | ||
246 | queryArgs = Tox.msgPayload | ||
247 | queryMethod = Tox.msgType | ||
248 | queryId = Tox.msgNonce | ||
249 | #endif | ||
250 | |||
251 | newtype ReflectedIP = ReflectedIP SockAddr | ||
252 | deriving (Eq, Ord, Show) | ||
203 | 253 | ||
204 | port16 :: Word16 -> PortNumber | 254 | port16 :: Word16 -> PortNumber |
205 | port16 = fromIntegral | 255 | port16 = fromIntegral |
@@ -237,8 +287,9 @@ encodeAddr _ = B.empty | |||
237 | -- | 287 | -- |
238 | -- * KResponse can be only sent from server to client. | 288 | -- * KResponse can be only sent from server to client. |
239 | -- | 289 | -- |
290 | #ifdef VERSION_bencoding | ||
240 | data KResponse = KResponse | 291 | data KResponse = KResponse |
241 | { respVals :: BValue -- ^ 'BDict' containing return values; | 292 | { respVals :: KQueryArgs -- ^ 'BDict' containing return values; |
242 | , respId :: TransactionId -- ^ match to the corresponding 'queryId'. | 293 | , respId :: TransactionId -- ^ match to the corresponding 'queryId'. |
243 | , respIP :: Maybe ReflectedIP | 294 | , respIP :: Maybe ReflectedIP |
244 | } deriving (Show, Eq, Ord, Typeable) | 295 | } deriving (Show, Eq, Ord, Typeable) |
@@ -265,11 +316,18 @@ instance BEncode KResponse where | |||
265 | addr <- optional (field (req "ip")) | 316 | addr <- optional (field (req "ip")) |
266 | (\r t -> KResponse r t addr) <$>! "r" <*>! "t" | 317 | (\r t -> KResponse r t addr) <$>! "r" <*>! "t" |
267 | {-# INLINE fromBEncode #-} | 318 | {-# INLINE fromBEncode #-} |
319 | #else | ||
320 | type KResponse = Tox.Message KQueryArgs | ||
321 | respVals = Tox.msgPayload | ||
322 | respId = Tox.msgNonce | ||
323 | respIP = Nothing :: Maybe ReflectedIP | ||
324 | #endif | ||
268 | 325 | ||
269 | {----------------------------------------------------------------------- | 326 | {----------------------------------------------------------------------- |
270 | -- Summed messages | 327 | -- Summed messages |
271 | -----------------------------------------------------------------------} | 328 | -----------------------------------------------------------------------} |
272 | 329 | ||
330 | #ifdef VERSION_bencoding | ||
273 | -- | Generic KRPC message. | 331 | -- | Generic KRPC message. |
274 | data KMessage | 332 | data KMessage |
275 | = Q KQuery | 333 | = Q KQuery |
@@ -287,3 +345,6 @@ instance BEncode KMessage where | |||
287 | <|> R <$> fromBEncode b | 345 | <|> R <$> fromBEncode b |
288 | <|> E <$> fromBEncode b | 346 | <|> E <$> fromBEncode b |
289 | <|> decodingError "KMessage: unknown message or message tag" | 347 | <|> decodingError "KMessage: unknown message or message tag" |
348 | #else | ||
349 | type KMessage = Tox.Message | ||
350 | #endif | ||