summaryrefslogtreecommitdiff
path: root/src/Remote/KRPC
diff options
context:
space:
mode:
Diffstat (limited to 'src/Remote/KRPC')
-rw-r--r--src/Remote/KRPC/Method.hs61
-rw-r--r--src/Remote/KRPC/Protocol.hs6
2 files changed, 40 insertions, 27 deletions
diff --git a/src/Remote/KRPC/Method.hs b/src/Remote/KRPC/Method.hs
index 420ceacf..8aa6ddc9 100644
--- a/src/Remote/KRPC/Method.hs
+++ b/src/Remote/KRPC/Method.hs
@@ -6,6 +6,7 @@
6-- Portability : portable 6-- Portability : portable
7-- 7--
8{-# LANGUAGE OverloadedStrings #-} 8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
9module Remote.KRPC.Method 10module Remote.KRPC.Method
10 ( Method(methodName, methodParams, methodVals) 11 ( Method(methodName, methodParams, methodVals)
11 , methodQueryScheme, methodRespScheme 12 , methodQueryScheme, methodRespScheme
@@ -14,13 +15,17 @@ module Remote.KRPC.Method
14 , method 15 , method
15 16
16 -- * Predefined methods 17 -- * Predefined methods
17 , idM, composeM 18 , idM
19
20 -- * Internal
21 , Extractable(..)
18 ) where 22 ) where
19 23
20import Prelude hiding ((.), id) 24import Prelude hiding ((.), id)
21import Control.Applicative 25import Control.Applicative
22import Control.Category 26import Control.Category
23import Control.Monad 27import Control.Monad
28import Data.BEncode
24import Data.ByteString as B 29import Data.ByteString as B
25import Data.List as L 30import Data.List as L
26import Data.Set as S 31import Data.Set as S
@@ -38,7 +43,7 @@ import Remote.KRPC.Protocol
38-- 43--
39data Method param result = Method { 44data Method param result = Method {
40 -- | Name used in query and 45 -- | Name used in query and
41 methodName :: [MethodName] 46 methodName :: MethodName
42 47
43 -- | Description of each parameter in /right to left/ order. 48 -- | Description of each parameter in /right to left/ order.
44 , methodParams :: [ParamName] 49 , methodParams :: [ParamName]
@@ -46,17 +51,8 @@ data Method param result = Method {
46 -- | Description of each return value in /right to left/ order. 51 -- | Description of each return value in /right to left/ order.
47 , methodVals :: [ValName] 52 , methodVals :: [ValName]
48 } 53 }
49
50instance Category Method where
51 {-# SPECIALIZE instance Category Method #-}
52 id = idM
53 {-# INLINE id #-}
54
55 (.) = composeM
56 {-# INLINE (.) #-}
57
58methodQueryScheme :: Method a b -> KQueryScheme 54methodQueryScheme :: Method a b -> KQueryScheme
59methodQueryScheme = KQueryScheme <$> B.intercalate "." . methodName 55methodQueryScheme = KQueryScheme <$> methodName
60 <*> S.fromList . methodParams 56 <*> S.fromList . methodParams
61{-# INLINE methodQueryScheme #-} 57{-# INLINE methodQueryScheme #-}
62 58
@@ -75,19 +71,32 @@ idM :: Method a a
75idM = method "id" ["x"] ["y"] 71idM = method "id" ["x"] ["y"]
76{-# INLINE idM #-} 72{-# INLINE idM #-}
77 73
78-- | Pipelining of two or more methods. 74method :: MethodName -> [ParamName] -> [ValName] -> Method param result
79-- 75method = Method
80-- NOTE: composed methods will work only with this implementation of 76{-# INLINE method #-}
81-- KRPC, so both server and client should use this implementation,
82-- otherwise you more likely get the 'ProtocolError'.
83--
84composeM :: Method b c -> Method a b -> Method a c
85composeM g h = Method (methodName g ++ methodName h)
86 (methodParams h)
87 (methodVals g)
88{-# INLINE composeM #-}
89 77
90 78
91method :: MethodName -> [ParamName] -> [ValName] -> Method param result 79
92method name = Method [name] 80class Extractable a where
93{-# INLINE method #-} \ No newline at end of file 81 injector :: a -> [BEncode]
82 extractor :: [BEncode] -> Result a
83
84instance (BEncodable a, BEncodable b) => Extractable (a, b) where
85 {- SPECIALIZE instance (BEncodable a, BEncodable b) => Extractable (a, b) -}
86 injector (a, b) = [toBEncode a, toBEncode b]
87 {-# INLINE injector #-}
88
89 extractor [a, b] = (,) <$> fromBEncode a <*> fromBEncode b
90 extractor _ = decodingError "unable to match pair"
91 {-# INLINE extractor #-}
92{-
93instance BEncodable a => Extractable a where
94 {-# SPECIALIZE instance BEncodable a => Extractable a #-}
95
96 injector x = [toBEncode x]
97 {-# INLINE injector #-}
98
99 extractor [x] = fromBEncode x
100 extractor _ = decodingError "unable to match single value"
101 {-# INLINE extractor #-}
102-} \ No newline at end of file
diff --git a/src/Remote/KRPC/Protocol.hs b/src/Remote/KRPC/Protocol.hs
index 625aba25..98674c51 100644
--- a/src/Remote/KRPC/Protocol.hs
+++ b/src/Remote/KRPC/Protocol.hs
@@ -74,7 +74,7 @@ class KMessage message scheme | message -> scheme where
74 validate = (==) . scheme 74 validate = (==) . scheme
75 {-# INLINE validate #-} 75 {-# INLINE validate #-}
76 76
77 77-- TODO Text -> ByteString
78-- TODO document that it is and how transferred 78-- TODO document that it is and how transferred
79data KError 79data KError
80 -- | Some error doesn't fit in any other category. 80 -- | Some error doesn't fit in any other category.
@@ -213,9 +213,13 @@ type KRemote = Socket
213withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m a 213withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m a
214withRemote = bracket (liftIO (socket AF_INET Datagram defaultProtocol)) 214withRemote = bracket (liftIO (socket AF_INET Datagram defaultProtocol))
215 (liftIO . sClose) 215 (liftIO . sClose)
216{-# SPECIALIZE withRemote :: (KRemote -> IO a) -> IO a #-}
217
216 218
217maxMsgSize :: Int 219maxMsgSize :: Int
218maxMsgSize = 16 * 1024 220maxMsgSize = 16 * 1024
221{-# INLINE maxMsgSize #-}
222
219 223
220-- TODO eliminate toStrict 224-- TODO eliminate toStrict
221sendMessage :: BEncodable msg => msg -> KRemoteAddr -> KRemote -> IO () 225sendMessage :: BEncodable msg => msg -> KRemoteAddr -> KRemote -> IO ()