summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-05-12 07:25:41 +0400
committerSam T <pxqr.sta@gmail.com>2013-05-12 07:25:41 +0400
commitfafdbec2cb64f11513bfe3a0a220562de97d9e36 (patch)
tree8491924a8e3010b575f0bc8c257ee0cd0e8517da /src
parenteff48f66c6d8e7231eef0ef3c3561e19865a2637 (diff)
~ Remove orphaned scheme validation.
Diffstat (limited to 'src')
-rw-r--r--src/Remote/KRPC/Method.hs14
-rw-r--r--src/Remote/KRPC/Protocol.hs45
2 files changed, 2 insertions, 57 deletions
diff --git a/src/Remote/KRPC/Method.hs b/src/Remote/KRPC/Method.hs
index 4283256b..4d91fe47 100644
--- a/src/Remote/KRPC/Method.hs
+++ b/src/Remote/KRPC/Method.hs
@@ -9,7 +9,6 @@
9{-# LANGUAGE FlexibleInstances, UndecidableInstances #-} 9{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
10module Remote.KRPC.Method 10module Remote.KRPC.Method
11 ( Method(methodName, methodParams, methodVals) 11 ( Method(methodName, methodParams, methodVals)
12 , methodQueryScheme, methodRespScheme
13 12
14 -- * Construction 13 -- * Construction
15 , method 14 , method
@@ -18,10 +17,6 @@ module Remote.KRPC.Method
18 , idM 17 , idM
19 ) where 18 ) where
20 19
21import Control.Applicative
22import Data.BEncode
23import Data.Set as S
24
25import Remote.KRPC.Protocol 20import Remote.KRPC.Protocol
26 21
27 22
@@ -43,15 +38,6 @@ data Method param result = Method {
43 -- | Description of each return value in /right to left/ order. 38 -- | Description of each return value in /right to left/ order.
44 , methodVals :: [ValName] 39 , methodVals :: [ValName]
45 } 40 }
46methodQueryScheme :: Method a b -> KQueryScheme
47methodQueryScheme = KQueryScheme <$> methodName
48 <*> S.fromList . methodParams
49{-# INLINE methodQueryScheme #-}
50
51
52methodRespScheme :: Method a b -> KResponseScheme
53methodRespScheme = KResponseScheme . S.fromList . methodVals
54{-# INLINE methodRespScheme #-}
55 41
56-- TODO ppMethod 42-- TODO ppMethod
57 43
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 #-}
18module Remote.KRPC.Protocol 18module 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
52import Data.ByteString.Char8 as BC 48import Data.ByteString.Char8 as BC
53import qualified Data.ByteString.Lazy as LB 49import qualified Data.ByteString.Lazy as LB
54import Data.Map as M 50import Data.Map as M
55import Data.Set as S
56 51
57import Network.Socket hiding (recvFrom) 52import Network.Socket hiding (recvFrom)
58import Network.Socket.ByteString 53import 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--
66class 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
79data KError 58data KError
@@ -102,11 +81,6 @@ instance BEncodable KError where
102 81
103 fromBEncode _ = decodingError "KError" 82 fromBEncode _ = decodingError "KError"
104 83
105instance KMessage KError ErrorCode where
106 {-# SPECIALIZE instance KMessage KError ErrorCode #-}
107 scheme = errorCode
108 {-# INLINE scheme #-}
109
110type ErrorCode = Int 84type ErrorCode = Int
111 85
112errorCode :: KError -> ErrorCode 86errorCode :: KError -> ErrorCode
@@ -157,15 +131,8 @@ kquery :: MethodName -> [(ParamName, BEncode)] -> KQuery
157kquery name args = KQuery name (M.fromList args) 131kquery name args = KQuery name (M.fromList args)
158{-# INLINE kquery #-} 132{-# INLINE kquery #-}
159 133
160data KQueryScheme = KQueryScheme {
161 qscMethod :: MethodName
162 , qscParams :: Set ParamName
163 } deriving (Show, Read, Eq, Ord)
164 134
165instance 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
170type ValName = ByteString 137type ValName = ByteString
171 138
@@ -191,14 +158,6 @@ kresponse :: [(ValName, BEncode)] -> KResponse
191kresponse = KResponse . M.fromList 158kresponse = KResponse . M.fromList
192{-# INLINE kresponse #-} 159{-# INLINE kresponse #-}
193 160
194newtype KResponseScheme = KResponseScheme {
195 rscVals :: Set ValName
196 } deriving (Show, Read, Eq, Ord)
197
198instance KMessage KResponse KResponseScheme where
199 {-# SPECIALIZE instance KMessage KResponse KResponseScheme #-}
200 scheme = KResponseScheme . keysSet . respVals
201 {-# INLINE scheme #-}
202 161
203 162
204type KRemoteAddr = (HostAddress, PortNumber) 163type KRemoteAddr = (HostAddress, PortNumber)