diff options
Diffstat (limited to 'src/Remote/KRPC/Protocol.hs')
-rw-r--r-- | src/Remote/KRPC/Protocol.hs | 45 |
1 files changed, 2 insertions, 43 deletions
diff --git a/src/Remote/KRPC/Protocol.hs b/src/Remote/KRPC/Protocol.hs index 7351831b..133c899a 100644 --- a/src/Remote/KRPC/Protocol.hs +++ b/src/Remote/KRPC/Protocol.hs | |||
@@ -17,19 +17,15 @@ | |||
17 | {-# LANGUAGE DefaultSignatures #-} | 17 | {-# LANGUAGE DefaultSignatures #-} |
18 | module Remote.KRPC.Protocol | 18 | module Remote.KRPC.Protocol |
19 | ( | 19 | ( |
20 | -- * Message | ||
21 | KMessage(..) | ||
22 | 20 | ||
23 | -- * Error | 21 | -- * Error |
24 | , KError(..), errorCode, mkKError | 22 | KError(..), errorCode, mkKError |
25 | 23 | ||
26 | -- * Query | 24 | -- * Query |
27 | , KQuery(queryMethod, queryArgs), MethodName, ParamName, kquery | 25 | , KQuery(queryMethod, queryArgs), MethodName, ParamName, kquery |
28 | , KQueryScheme(KQueryScheme, qscMethod, qscParams) | ||
29 | 26 | ||
30 | -- * Response | 27 | -- * Response |
31 | , KResponse(respVals), ValName, kresponse | 28 | , KResponse(respVals), ValName, kresponse |
32 | , KResponseScheme(KResponseScheme, rscVals) | ||
33 | 29 | ||
34 | , sendMessage, recvResponse | 30 | , sendMessage, recvResponse |
35 | 31 | ||
@@ -52,28 +48,11 @@ import Data.ByteString as B | |||
52 | import Data.ByteString.Char8 as BC | 48 | import Data.ByteString.Char8 as BC |
53 | import qualified Data.ByteString.Lazy as LB | 49 | import qualified Data.ByteString.Lazy as LB |
54 | import Data.Map as M | 50 | import Data.Map as M |
55 | import Data.Set as S | ||
56 | 51 | ||
57 | import Network.Socket hiding (recvFrom) | 52 | import Network.Socket hiding (recvFrom) |
58 | import Network.Socket.ByteString | 53 | import Network.Socket.ByteString |
59 | 54 | ||
60 | 55 | ||
61 | |||
62 | -- | Used to validate message by its scheme | ||
63 | -- | ||
64 | -- forall m. m `validate` scheme m | ||
65 | -- | ||
66 | class KMessage message scheme | message -> scheme where | ||
67 | -- | Get a message scheme. | ||
68 | scheme :: message -> scheme | ||
69 | |||
70 | -- | Check a message with a scheme. | ||
71 | validate :: message -> scheme -> Bool | ||
72 | |||
73 | default validate :: Eq scheme => message -> scheme -> Bool | ||
74 | validate = (==) . scheme | ||
75 | {-# INLINE validate #-} | ||
76 | |||
77 | -- TODO Text -> ByteString | 56 | -- TODO Text -> ByteString |
78 | -- TODO document that it is and how transferred | 57 | -- TODO document that it is and how transferred |
79 | data KError | 58 | data KError |
@@ -102,11 +81,6 @@ instance BEncodable KError where | |||
102 | 81 | ||
103 | fromBEncode _ = decodingError "KError" | 82 | fromBEncode _ = decodingError "KError" |
104 | 83 | ||
105 | instance KMessage KError ErrorCode where | ||
106 | {-# SPECIALIZE instance KMessage KError ErrorCode #-} | ||
107 | scheme = errorCode | ||
108 | {-# INLINE scheme #-} | ||
109 | |||
110 | type ErrorCode = Int | 84 | type ErrorCode = Int |
111 | 85 | ||
112 | errorCode :: KError -> ErrorCode | 86 | errorCode :: KError -> ErrorCode |
@@ -157,15 +131,8 @@ kquery :: MethodName -> [(ParamName, BEncode)] -> KQuery | |||
157 | kquery name args = KQuery name (M.fromList args) | 131 | kquery name args = KQuery name (M.fromList args) |
158 | {-# INLINE kquery #-} | 132 | {-# INLINE kquery #-} |
159 | 133 | ||
160 | data KQueryScheme = KQueryScheme { | ||
161 | qscMethod :: MethodName | ||
162 | , qscParams :: Set ParamName | ||
163 | } deriving (Show, Read, Eq, Ord) | ||
164 | 134 | ||
165 | instance KMessage KQuery KQueryScheme where | 135 | |
166 | {-# SPECIALIZE instance KMessage KQuery KQueryScheme #-} | ||
167 | scheme q = KQueryScheme (queryMethod q) (M.keysSet (queryArgs q)) | ||
168 | {-# INLINE scheme #-} | ||
169 | 136 | ||
170 | type ValName = ByteString | 137 | type ValName = ByteString |
171 | 138 | ||
@@ -191,14 +158,6 @@ kresponse :: [(ValName, BEncode)] -> KResponse | |||
191 | kresponse = KResponse . M.fromList | 158 | kresponse = KResponse . M.fromList |
192 | {-# INLINE kresponse #-} | 159 | {-# INLINE kresponse #-} |
193 | 160 | ||
194 | newtype KResponseScheme = KResponseScheme { | ||
195 | rscVals :: Set ValName | ||
196 | } deriving (Show, Read, Eq, Ord) | ||
197 | |||
198 | instance KMessage KResponse KResponseScheme where | ||
199 | {-# SPECIALIZE instance KMessage KResponse KResponseScheme #-} | ||
200 | scheme = KResponseScheme . keysSet . respVals | ||
201 | {-# INLINE scheme #-} | ||
202 | 161 | ||
203 | 162 | ||
204 | type KRemoteAddr = (HostAddress, PortNumber) | 163 | type KRemoteAddr = (HostAddress, PortNumber) |