diff options
-rw-r--r-- | src/Network/KRPC/Message.hs | 91 | ||||
-rw-r--r-- | src/Network/KRPC/Method.hs | 1 |
2 files changed, 61 insertions, 31 deletions
diff --git a/src/Network/KRPC/Message.hs b/src/Network/KRPC/Message.hs index 1e1dc065..d6279f11 100644 --- a/src/Network/KRPC/Message.hs +++ b/src/Network/KRPC/Message.hs | |||
@@ -5,9 +5,10 @@ | |||
5 | -- Stability : experimental | 5 | -- Stability : experimental |
6 | -- Portability : portable | 6 | -- Portability : portable |
7 | -- | 7 | -- |
8 | -- This module provides straightforward implementation of KRPC | 8 | -- KRPC messages types used in communication. All messages are |
9 | -- protocol. In many situations 'Network.KRPC' should be prefered | 9 | -- encoded as bencode dictionary. |
10 | -- since it gives more safe, convenient and high level api. | 10 | -- |
11 | -- Normally, you don't need to import this module. | ||
11 | -- | 12 | -- |
12 | -- See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol> | 13 | -- See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol> |
13 | -- | 14 | -- |
@@ -21,7 +22,6 @@ | |||
21 | module Network.KRPC.Message | 22 | module Network.KRPC.Message |
22 | ( -- * Transaction | 23 | ( -- * Transaction |
23 | TransactionId | 24 | TransactionId |
24 | , unknownTransaction | ||
25 | 25 | ||
26 | -- * Error | 26 | -- * Error |
27 | , ErrorCode (..) | 27 | , ErrorCode (..) |
@@ -65,6 +65,7 @@ unknownTransaction = "" | |||
65 | -- Error messages | 65 | -- Error messages |
66 | -----------------------------------------------------------------------} | 66 | -----------------------------------------------------------------------} |
67 | 67 | ||
68 | -- | Types of RPC errors. | ||
68 | data ErrorCode | 69 | data ErrorCode |
69 | -- | Some error doesn't fit in any other category. | 70 | -- | Some error doesn't fit in any other category. |
70 | = GenericError | 71 | = GenericError |
@@ -79,6 +80,8 @@ data ErrorCode | |||
79 | | MethodUnknown | 80 | | MethodUnknown |
80 | deriving (Show, Read, Eq, Ord, Bounded, Typeable) | 81 | deriving (Show, Read, Eq, Ord, Bounded, Typeable) |
81 | 82 | ||
83 | -- | According to the table: | ||
84 | -- <http://bittorrent.org/beps/bep_0005.html#errors> | ||
82 | instance Enum ErrorCode where | 85 | instance Enum ErrorCode where |
83 | fromEnum GenericError = 201 | 86 | fromEnum GenericError = 201 |
84 | fromEnum ServerError = 202 | 87 | fromEnum ServerError = 202 |
@@ -100,22 +103,31 @@ instance BEncode ErrorCode where | |||
100 | fromBEncode b = toEnum <$> fromBEncode b | 103 | fromBEncode b = toEnum <$> fromBEncode b |
101 | {-# INLINE fromBEncode #-} | 104 | {-# INLINE fromBEncode #-} |
102 | 105 | ||
103 | -- | Errors used to signal that some error occurred while processing a | 106 | -- | Errors are sent when a query cannot be fulfilled. Error message |
104 | -- procedure call. Error may be send only from server to client but | 107 | -- can be send only from server to client but not in the opposite |
105 | -- not in the opposite direction. | 108 | -- direction. |
106 | -- | ||
107 | -- Errors are encoded as bencoded dictionary: | ||
108 | -- | ||
109 | -- > { "y" : "e", "e" : [<error_code>, <human_readable_error_reason>] } | ||
110 | -- | 109 | -- |
111 | data KError = KError | 110 | data KError = KError |
112 | { errorCode :: !ErrorCode | 111 | { errorCode :: !ErrorCode -- ^ the type of error; |
113 | , errorMessage :: !ByteString | 112 | , errorMessage :: !ByteString -- ^ human-readable text message; |
114 | , errorId :: !TransactionId | 113 | , errorId :: !TransactionId -- ^ match to the corresponding 'queryId'. |
115 | } deriving (Show, Read, Eq, Ord, Typeable) | 114 | } deriving (Show, Read, Eq, Ord, Typeable) |
116 | 115 | ||
116 | -- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\", | ||
117 | -- contain one additional key \"e\". The value of \"e\" is a | ||
118 | -- list. The first element is an integer representing the error | ||
119 | -- code. The second element is a string containing the error | ||
120 | -- message. | ||
121 | -- | ||
122 | -- Example Error Packet: | ||
123 | -- | ||
124 | -- > { "t": "aa", "y":"e", "e":[201, "A Generic Error Ocurred"]} | ||
125 | -- | ||
126 | -- or bencoded: | ||
127 | -- | ||
128 | -- > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee | ||
129 | -- | ||
117 | instance BEncode KError where | 130 | instance BEncode KError where |
118 | |||
119 | toBEncode KError {..} = toDict $ | 131 | toBEncode KError {..} = toDict $ |
120 | "e" .=! (errorCode, errorMessage) | 132 | "e" .=! (errorCode, errorMessage) |
121 | .: "t" .=! errorId | 133 | .: "t" .=! errorId |
@@ -131,7 +143,7 @@ instance BEncode KError where | |||
131 | 143 | ||
132 | instance Exception KError | 144 | instance Exception KError |
133 | 145 | ||
134 | -- | Happen when some handler fail. | 146 | -- | Happen when some query handler fail. |
135 | serverError :: SomeException -> TransactionId -> KError | 147 | serverError :: SomeException -> TransactionId -> KError |
136 | serverError e = KError ServerError (BC.pack (show e)) | 148 | serverError e = KError ServerError (BC.pack (show e)) |
137 | 149 | ||
@@ -164,16 +176,21 @@ type MethodName = ByteString | |||
164 | -- callee and pass arguments in. Therefore query may be only sent from | 176 | -- callee and pass arguments in. Therefore query may be only sent from |
165 | -- client to server but not in the opposite direction. | 177 | -- client to server but not in the opposite direction. |
166 | -- | 178 | -- |
167 | -- Queries are encoded as bencoded dictionary: | ||
168 | -- | ||
169 | -- > { "y" : "q", "q" : "<method_name>", "a" : [<arg1>, <arg2>, ...] } | ||
170 | -- | ||
171 | data KQuery = KQuery | 179 | data KQuery = KQuery |
172 | { queryArgs :: !BValue | 180 | { queryArgs :: !BValue -- ^ values to be passed to method; |
173 | , queryMethod :: !MethodName | 181 | , queryMethod :: !MethodName -- ^ method to call; |
174 | , queryId :: !TransactionId | 182 | , queryId :: !TransactionId -- ^ one-time query token. |
175 | } deriving (Show, Read, Eq, Ord, Typeable) | 183 | } deriving (Show, Read, Eq, Ord, Typeable) |
176 | 184 | ||
185 | -- | Queries, or KRPC message dictionaries with a \"y\" value of | ||
186 | -- \"q\", contain two additional keys; \"q\" and \"a\". Key \"q\" has | ||
187 | -- a string value containing the method name of the query. Key \"a\" | ||
188 | -- has a dictionary value containing named arguments to the query. | ||
189 | -- | ||
190 | -- Example Query packet: | ||
191 | -- | ||
192 | -- > { "t" : "aa", "y" : "q", "q" : "ping", "a" : { "msg" : "hi!" } } | ||
193 | -- | ||
177 | instance BEncode KQuery where | 194 | instance BEncode KQuery where |
178 | toBEncode KQuery {..} = toDict $ | 195 | toBEncode KQuery {..} = toDict $ |
179 | "a" .=! queryArgs | 196 | "a" .=! queryArgs |
@@ -192,20 +209,30 @@ instance BEncode KQuery where | |||
192 | -- Response messages | 209 | -- Response messages |
193 | -----------------------------------------------------------------------} | 210 | -----------------------------------------------------------------------} |
194 | 211 | ||
195 | -- | KResponse used to signal that callee successufully process a | 212 | -- | Response messages are sent upon successful completion of a |
196 | -- procedure call and to return values from procedure. KResponse should | 213 | -- query: |
197 | -- not be sent if error occurred during RPC. Thus KResponse may be only | ||
198 | -- sent from server to client. | ||
199 | -- | 214 | -- |
200 | -- Responses are encoded as bencoded dictionary: | 215 | -- * KResponse used to signal that callee successufully process a |
216 | -- procedure call and to return values from procedure. | ||
201 | -- | 217 | -- |
202 | -- > { "y" : "r", "r" : [<val1>, <val2>, ...] } | 218 | -- * KResponse should not be sent if error occurred during RPC, |
219 | -- 'KError' should be sent instead. | ||
220 | -- | ||
221 | -- * KResponse can be only sent from server to client. | ||
203 | -- | 222 | -- |
204 | data KResponse = KResponse | 223 | data KResponse = KResponse |
205 | { respVals :: BValue | 224 | { respVals :: BValue -- ^ 'BDict' containing return values; |
206 | , respId :: TransactionId | 225 | , respId :: TransactionId -- ^ match to the corresponding 'queryId'. |
207 | } deriving (Show, Read, Eq, Ord, Typeable) | 226 | } deriving (Show, Read, Eq, Ord, Typeable) |
208 | 227 | ||
228 | -- | Responses, or KRPC message dictionaries with a \"y\" value of | ||
229 | -- \"r\", contain one additional key \"r\". The value of \"r\" is a | ||
230 | -- dictionary containing named return values. | ||
231 | -- | ||
232 | -- Example Response packet: | ||
233 | -- | ||
234 | -- > { "t" : "aa", "y" : "r", "r" : { "msg" : "you've sent: hi!" } } | ||
235 | -- | ||
209 | instance BEncode KResponse where | 236 | instance BEncode KResponse where |
210 | toBEncode KResponse {..} = toDict $ | 237 | toBEncode KResponse {..} = toDict $ |
211 | "r" .=! respVals | 238 | "r" .=! respVals |
@@ -223,6 +250,7 @@ instance BEncode KResponse where | |||
223 | -- Summed messages | 250 | -- Summed messages |
224 | -----------------------------------------------------------------------} | 251 | -----------------------------------------------------------------------} |
225 | 252 | ||
253 | -- | Generic KRPC message. | ||
226 | data KMessage | 254 | data KMessage |
227 | = Q KQuery | 255 | = Q KQuery |
228 | | R KResponse | 256 | | R KResponse |
@@ -238,3 +266,4 @@ instance BEncode KMessage where | |||
238 | Q <$> fromBEncode b | 266 | Q <$> fromBEncode b |
239 | <|> R <$> fromBEncode b | 267 | <|> R <$> fromBEncode b |
240 | <|> E <$> fromBEncode b | 268 | <|> E <$> fromBEncode b |
269 | <|> decodingError "KMessage: unknown message or message tag" \ No newline at end of file | ||
diff --git a/src/Network/KRPC/Method.hs b/src/Network/KRPC/Method.hs index f2461a1b..f4392f35 100644 --- a/src/Network/KRPC/Method.hs +++ b/src/Network/KRPC/Method.hs | |||
@@ -63,6 +63,7 @@ showsMethod (Method name) = | |||
63 | class (BEncode req, BEncode resp) => KRPC req resp | req -> resp where | 63 | class (BEncode req, BEncode resp) => KRPC req resp | req -> resp where |
64 | method :: Method req resp | 64 | method :: Method req resp |
65 | 65 | ||
66 | -- TODO add underscores | ||
66 | default method :: Typeable req => Method req resp | 67 | default method :: Typeable req => Method req resp |
67 | method = Method $ fromString $ L.map toLower $ show $ typeOf hole | 68 | method = Method $ fromString $ L.map toLower $ show $ typeOf hole |
68 | where | 69 | where |