summaryrefslogtreecommitdiff
path: root/src/Network/KRPC
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/KRPC')
-rw-r--r--src/Network/KRPC/Message.hs118
1 files changed, 73 insertions, 45 deletions
diff --git a/src/Network/KRPC/Message.hs b/src/Network/KRPC/Message.hs
index 1a004c64..a70c2ea9 100644
--- a/src/Network/KRPC/Message.hs
+++ b/src/Network/KRPC/Message.hs
@@ -20,7 +20,8 @@
20{-# LANGUAGE DeriveDataTypeable #-} 20{-# LANGUAGE DeriveDataTypeable #-}
21module Network.KRPC.Message 21module Network.KRPC.Message
22 ( -- * Error 22 ( -- * Error
23 KError(..) 23 ErrorCode (..)
24 , KError(..)
24 , serverError 25 , serverError
25 26
26 -- * Query 27 -- * Query
@@ -31,13 +32,60 @@ module Network.KRPC.Message
31 , KResponse(..) 32 , KResponse(..)
32 ) where 33 ) where
33 34
35import Control.Applicative
34import Control.Exception.Lifted as Lifted 36import Control.Exception.Lifted as Lifted
35import Data.BEncode as BE 37import Data.BEncode as BE
36import Data.BEncode.BDict as BE
37import Data.ByteString as B 38import Data.ByteString as B
38import Data.ByteString.Char8 as BC 39import Data.ByteString.Char8 as BC
39import Data.Typeable 40import Data.Typeable
40 41
42
43-- | This transaction ID is generated by the querying node and is
44-- echoed in the response, so responses may be correlated with
45-- multiple queries to the same node. The transaction ID should be
46-- encoded as a short string of binary numbers, typically 2 characters
47-- are enough as they cover 2^16 outstanding queries.
48type TransactionId = ByteString
49
50{-----------------------------------------------------------------------
51-- Error messages
52-----------------------------------------------------------------------}
53
54data ErrorCode
55 -- | Some error doesn't fit in any other category.
56 = GenericError
57
58 -- | Occur when server fail to process procedure call.
59 | ServerError
60
61 -- | Malformed packet, invalid arguments or bad token.
62 | ProtocolError
63
64 -- | Occur when client trying to call method server don't know.
65 | MethodUnknown
66 deriving (Show, Read, Eq, Ord, Bounded, Typeable)
67
68instance Enum ErrorCode where
69 fromEnum GenericError = 201
70 fromEnum ServerError = 202
71 fromEnum ProtocolError = 203
72 fromEnum MethodUnknown = 204
73 {-# INLINE fromEnum #-}
74
75 toEnum 201 = GenericError
76 toEnum 202 = ServerError
77 toEnum 203 = ProtocolError
78 toEnum 204 = MethodUnknown
79 toEnum _ = GenericError
80 {-# INLINE toEnum #-}
81
82instance BEncode ErrorCode where
83 toBEncode = toBEncode . fromEnum
84 {-# INLINE toBEncode #-}
85
86 fromBEncode b = toEnum <$> fromBEncode b
87 {-# INLINE fromBEncode #-}
88
41-- | Errors used to signal that some error occurred while processing a 89-- | Errors used to signal that some error occurred while processing a
42-- procedure call. Error may be send only from server to client but 90-- procedure call. Error may be send only from server to client but
43-- not in the opposite direction. 91-- not in the opposite direction.
@@ -46,62 +94,38 @@ import Data.Typeable
46-- 94--
47-- > { "y" : "e", "e" : [<error_code>, <human_readable_error_reason>] } 95-- > { "y" : "e", "e" : [<error_code>, <human_readable_error_reason>] }
48-- 96--
49data KError 97data KError = KError
50 -- | Some error doesn't fit in any other category. 98 { errorCode :: !ErrorCode
51 = GenericError { errorMessage :: !ByteString } 99 , errorMessage :: !ByteString
52 100 , errorId :: !TransactionId
53 -- | Occur when server fail to process procedure call. 101 } deriving (Show, Read, Eq, Ord, Typeable)
54 | ServerError { errorMessage :: !ByteString }
55
56 -- | Malformed packet, invalid arguments or bad token.
57 | ProtocolError { errorMessage :: !ByteString }
58
59 -- | Occur when client trying to call method server don't know.
60 | MethodUnknown { errorMessage :: !ByteString }
61 deriving (Show, Read, Eq, Ord, Typeable)
62 102
63instance BEncode KError where 103instance BEncode KError where
64 {-# SPECIALIZE instance BEncode KError #-} 104
65 {-# INLINE toBEncode #-} 105 toBEncode KError {..} = toDict $
66 toBEncode e = toDict $ 106 "e" .=! (errorCode, errorMessage)
67 "e" .=! (errorCode e, errorMessage e) 107 .: "t" .=! errorId
68 .: "y" .=! ("e" :: ByteString) 108 .: "y" .=! ("e" :: ByteString)
69 .: endDict 109 .: endDict
110 {-# INLINE toBEncode #-}
70 111
112 fromBEncode = fromDict $ do
113 lookAhead $ match "y" (BString "e")
114 (code, msg) <- field (req "e")
115 KError code msg <$>! "t"
71 {-# INLINE fromBEncode #-} 116 {-# INLINE fromBEncode #-}
72 fromBEncode be @ (BDict d)
73 | BE.lookup "y" d == Just (BString "e")
74 = (`fromDict` be) $ do
75 uncurry mkKError <$>! "e"
76
77 fromBEncode _ = decodingError "KError"
78 117
79instance Exception KError 118instance Exception KError
80 119
81type ErrorCode = Int 120serverError :: SomeException -> TransactionId -> KError
82 121serverError e = KError ServerError (BC.pack (show e))
83errorCode :: KError -> ErrorCode
84errorCode (GenericError _) = 201
85errorCode (ServerError _) = 202
86errorCode (ProtocolError _) = 203
87errorCode (MethodUnknown _) = 204
88{-# INLINE errorCode #-}
89 122
90mkKError :: ErrorCode -> ByteString -> KError 123{-----------------------------------------------------------------------
91mkKError 201 = GenericError 124-- Query messages
92mkKError 202 = ServerError 125-----------------------------------------------------------------------}
93mkKError 203 = ProtocolError
94mkKError 204 = MethodUnknown
95mkKError _ = GenericError
96{-# INLINE mkKError #-}
97
98serverError :: SomeException -> KError
99serverError = ServerError . BC.pack . show
100 126
101type MethodName = ByteString 127type MethodName = ByteString
102 128
103type TransactionId = ByteString
104
105-- | Query used to signal that caller want to make procedure call to 129-- | Query used to signal that caller want to make procedure call to
106-- callee and pass arguments in. Therefore query may be only sent from 130-- callee and pass arguments in. Therefore query may be only sent from
107-- client to server but not in the opposite direction. 131-- client to server but not in the opposite direction.
@@ -130,6 +154,10 @@ instance BEncode KQuery where
130 KQuery <$>! "a" <*>! "q" <*>! "t" 154 KQuery <$>! "a" <*>! "q" <*>! "t"
131 {-# INLINE fromBEncode #-} 155 {-# INLINE fromBEncode #-}
132 156
157{-----------------------------------------------------------------------
158-- Response messages
159-----------------------------------------------------------------------}
160
133-- | KResponse used to signal that callee successufully process a 161-- | KResponse used to signal that callee successufully process a
134-- procedure call and to return values from procedure. KResponse should 162-- procedure call and to return values from procedure. KResponse should
135-- not be sent if error occurred during RPC. Thus KResponse may be only 163-- not be sent if error occurred during RPC. Thus KResponse may be only