krpc 0.2.2.0 → 0.3.0.0
raw patch · 14 files changed
+771/−714 lines, 14 filesdep ~bencoding
Dependency ranges changed: bencoding
Files
- NEWS.md +7/−0
- README.md +39/−0
- bench/Main.hs +1/−1
- bench/Server.hs +1/−1
- krpc.cabal +10/−14
- src/Network/KRPC.hs +362/−0
- src/Network/KRPC/Protocol.hs +266/−0
- src/Network/KRPC/Scheme.hs +80/−0
- src/Remote/KRPC.hs +0/−362
- src/Remote/KRPC/Protocol.hs +0/−251
- src/Remote/KRPC/Scheme.hs +0/−80
- tests/Client.hs +1/−1
- tests/Server.hs +1/−1
- tests/Shared.hs +3/−3
+ NEWS.md view
@@ -0,0 +1,7 @@+* 0.1.0.0: Initial version.+* 0.1.1.0: Allow passing raw argument\/result dictionaries.+* 0.2.0.0: Async API have been removed, use /async/ package instead.+ Expose caller address in handlers.+* 0.2.2.0: Use bencoding-0.2.2.*+* 0.3.0.0: Use bencoding-0.3.*+ Rename Remote.* to Network.* modules.
+ README.md view
@@ -0,0 +1,39 @@+### Synopsis++KRPC is simple remote procedure call mechanism used by bittorrent DHT+but might be used anywhere else.++### Description++KRPC basically consisting of bencoded dictionaries sent over UDP. This+implementation provides extra safiety by separation of procedure+signature and implementation and baking procedure type in host+language, thus it's hard to shoot yourself in the foot accidently.++See bittorrent DHT [specification][spec] for detailed protocol+description.++#### Modules++* Remote.KRPC — simple interface which reduce all RPC related stuff to+ a few lines. Should be used in the first place.++* Remote.KRPC.Protocol — raw protocol implementation.+* Remote.KRPC.Scheme — message validation.++### Documentation++For usage see examples in ```examples``` directory.+For documentation see haddock generated documentation.++### Build Status [![Build Status][status-img]][status-link]++### Maintainer <pxqr.sta@gmail.com>++Feel free to report bugs and suggestions via github+[issue tracker][issues] or the mail.++[spec]: http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol+[status-img]: https://travis-ci.org/cobit/krpc.png+[status-link]: https://travis-ci.org/cobit/krpc+[issues]: https://github.com/cobit/krpc/issues
bench/Main.hs view
@@ -5,7 +5,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import Criterion.Main-import Remote.KRPC+import Network.KRPC addr :: RemoteAddr
bench/Server.hs view
@@ -2,7 +2,7 @@ module Main (main) where import Data.ByteString (ByteString)-import Remote.KRPC+import Network.KRPC echo :: Method ByteString ByteString
krpc.cabal view
@@ -1,5 +1,5 @@ name: krpc-version: 0.2.2.0+version: 0.3.0.0 license: BSD3 license-file: LICENSE author: Sam Truzjan@@ -17,15 +17,11 @@ KRPC remote procedure call protocol implementation. .- [/Release Notes/]- .- * /0.1.0.0:/ Initial version.- .- * /0.1.1.0:/ Allow passing raw argument\/result dictionaries.- .- * /0.2.0.0:/ Async API have been removed, use /async/ package instead.- Expose caller address in handlers.+ See NEWS.md for release notes. +extra-source-files: README.md+ , NEWS.md+ source-repository head type: git location: git://github.com/cobit/krpc.git@@ -35,16 +31,16 @@ type: git location: git://github.com/cobit/krpc.git branch: master- tag: v0.2.2.0+ tag: v0.3.0.0 library default-language: Haskell2010 default-extensions: PatternGuards , RecordWildCards hs-source-dirs: src- exposed-modules: Remote.KRPC- , Remote.KRPC.Protocol- , Remote.KRPC.Scheme+ exposed-modules: Network.KRPC+ , Network.KRPC.Protocol+ , Network.KRPC.Scheme build-depends: base == 4.* , lifted-base >= 0.1.1@@ -53,7 +49,7 @@ , bytestring >= 0.10 , containers >= 0.4- , bencoding == 0.2.2.*+ , bencoding == 0.3.* , network >= 2.3 ghc-options: -Wall
+ src/Network/KRPC.hs view
@@ -0,0 +1,362 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- This module provides safe remote procedure call. One important+-- point is exceptions and errors, so be able handle them properly+-- we need to investigate a bit about how this all works.+-- Internally, in order to make method invokation KRPC makes the+-- following steps:+--+-- * Caller serialize arguments to bencoded bytestrings;+--+-- * Caller send bytestring data over UDP to the callee;+--+-- * Callee receive and decode arguments to the method and method+-- name. If it can't decode then it send 'ProtocolError' back to the+-- caller;+--+-- * Callee search for the @method name@ in the method table.+-- If it not present in the table then callee send 'MethodUnknown'+-- back to the caller;+--+-- * Callee check if argument names match. If not it send+-- 'ProtocolError' back;+--+-- * Callee make the actuall call to the plain old haskell+-- function. If the function throw exception then callee send+-- 'ServerError' back.+--+-- * Callee serialize result of the function to bencoded bytestring.+--+-- * Callee encode result to bencoded bytestring and send it back+-- to the caller.+--+-- * Caller check if return values names match with the signature+-- it called in the first step.+--+-- * Caller extracts results and finally return results of the+-- procedure call as ordinary haskell values.+--+-- If every other error occurred caller get the 'GenericError'. All+-- errors returned by callee are throwed as ordinary haskell+-- exceptions at caller side. Make sure that both callee and caller+-- uses the same method signatures and everything should be ok: this+-- KRPC implementation provides some level of safety through+-- types. Also note that both caller and callee use plain UDP, so+-- KRPC is unreliable.+--+-- Consider one tiny example. From now @caller = client@ and+-- @callee = server or remote@.+--+-- Somewhere we have to define all procedure signatures. Imagine+-- that this is a library shared between client and server:+--+-- > factorialMethod :: Method Int Int+-- > factorialMethod = method "factorial" ["x"] ["y"]+--+-- Otherwise you can define this code in both client and server of+-- course. But in this case you might get into troubles: you can get+-- 'MethodUnknown' or 'ProtocolError' if name or type of method+-- will mismatch after not synced changes in client or server code.+--+-- Now let's define our client-side:+--+-- > main = withRemote $ \remote -> do+-- > result <- call remote (0, 6000) factorialMethod 4+-- > assert (result == 24) $ print "Success!"+--+-- It basically open socket with 'withRemote' and make all the other+-- steps in 'call' as describe above. And finally our server-side:+--+-- > factorialImpl :: Int -> Int+-- > factorialImpl n = product [1..n]+-- >+-- > main = runServer [factorialMethod $ return . factorialImpl]+--+-- Here we implement method signature from that shared lib and run+-- server with runServer by passing method table in.+--+-- For async API use /async/ package, old API have been removed.+--+-- For more examples see @exsamples@ or @tests@ directories.+--+-- For protocol details see 'Remote.KRPC.Protocol' module.+--+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveGeneric #-}+module Network.KRPC+ ( -- * Method+ Method(..)+ , method, idM++ -- * Client+ , RemoteAddr+ , RPCException(..)+ , call++ -- * Server+ , MethodHandler+ , (==>)+ , (==>@)+ , server++ -- * Internal+ , call_+ , withRemote+ ) where++import Control.Applicative+import Control.Exception+import Control.Monad.Trans.Control+import Control.Monad.IO.Class+import Data.BEncode+import Data.ByteString.Char8 as BC+import Data.List as L+import Data.Map as M+import Data.Monoid+import Data.Typeable+import Network+import GHC.Generics++import Network.KRPC.Protocol+++-- | Method datatype used to describe name, parameters and return+-- values of procedure. Client use a method to /invoke/, server+-- /implements/ the method to make the actual work.+--+-- We use the following fantom types to ensure type-safiety:+--+-- * param: Type of method parameters. Ordinary Tuple type used+-- to specify more than one parameter, so for example @Method+-- (Int, Int) result@ will take two arguments.+--+-- * result: Type of return value of the method. Similarly,+-- tuple used to specify more than one return value, so for+-- exsample @Method (Foo, Bar) (Bar, Foo)@ will take two arguments+-- and return two values.+--+-- To pass raw dictionaries you should specify empty param list:+--+-- > method "my_method" [] [] :: Method BEncode BEncode+--+-- In this case you should handle dictionary extraction by hand, both+-- in client and server.+--+data Method param result = Method {+ -- | Name used in query.+ methodName :: MethodName++ -- | Name of each parameter in /right to left/ order.+ , methodParams :: [ParamName]++ -- | Name of each return value in /right to left/ order.+ , methodVals :: [ValName]+ } deriving (Eq, Ord, Generic)++instance BEncode (Method a b)++instance (Typeable a, Typeable b) => Show (Method a b) where+ showsPrec _ = showsMethod++showsMethod+ :: forall a. forall b.+ Typeable a => Typeable b+ => Method a b -> ShowS+showsMethod Method {..} =+ showString (BC.unpack methodName) <>+ showString " :: " <>+ showsTuple methodParams paramsTy <>+ showString " -> " <>+ showsTuple methodVals valuesTy+ where+ paramsTy = typeOf (error "KRPC.showsMethod: impossible" :: a)+ valuesTy = typeOf (error "KRPC.showsMethod: impossible" :: b)++ showsTuple ns ty+ = showChar '('+ <> mconcat (L.intersperse (showString ", ") $+ L.zipWith showsTyArgName ns (detuple ty))+ <> showChar ')'++ showsTyArgName ns ty+ = showString (BC.unpack ns)+ <> showString " :: "+ <> showString (show ty)++ detuple tyRep+ | L.null args = [tyRep]+ | otherwise = args+ where+ args = typeRepArgs tyRep+++-- | Identity procedure signature. Could be used for echo+-- servers. Implemented as:+--+-- > idM = method "id" ["x"] ["y"]+--+idM :: Method a a+idM = method "id" ["x"] ["y"]+{-# INLINE idM #-}++-- | Makes method signature. Note that order of parameters and return+-- values are not important as long as corresponding names and types+-- are match. For exsample this is the equal definitions:+--+-- > methodA : Method (Foo, Bar) (Baz, Quux)+-- > methodA = method "mymethod" ["a", "b"] ["c", "d"]+--+-- > methodA : Method (Bar, Foo) (Quux, Baz)+-- > methodB = method "mymethod" ["b", "a"] ["d", "c"]+--+method :: MethodName -> [ParamName] -> [ValName] -> Method param result+method = Method+{-# INLINE method #-}++lookupKey :: ParamName -> BDict -> Result BValue+lookupKey x = maybe (Left ("not found key " ++ BC.unpack x)) Right . M.lookup x++extractArgs :: [ParamName] -> BDict -> Result BValue+extractArgs [] d = Right $ if M.null d then BList [] else BDict d+extractArgs [x] d = lookupKey x d+extractArgs xs d = BList <$> mapM (`lookupKey` d) xs+{-# INLINE extractArgs #-}++injectVals :: [ParamName] -> BValue -> [(ParamName, BValue)]+injectVals [] (BList []) = []+injectVals [] (BDict d ) = M.toList d+injectVals [] be = invalidParamList [] be+injectVals [p] arg = [(p, arg)]+injectVals ps (BList as) = L.zip ps as+injectVals ps be = invalidParamList ps be+{-# INLINE injectVals #-}++invalidParamList :: [ParamName] -> BValue -> a+invalidParamList pl be+ = error $ "KRPC invalid parameter list: " ++ show pl ++ "\n" +++ "while procedure args are: " ++ show be++-- | Alias to Socket, through might change in future.+type Remote = Socket++-- | Represent any error mentioned by protocol specification that+-- 'call', 'await' might throw.+-- For more details see 'Remote.KRPC.Protocol'.+--+data RPCException = RPCException KError+ deriving (Show, Eq, Typeable)++instance Exception RPCException++-- | Address of remote can be called by client.+type RemoteAddr = KRemoteAddr++queryCall :: BEncode param+ => KRemote -> KRemoteAddr+ -> Method param result -> param -> IO ()+queryCall sock addr m arg = sendMessage q addr sock+ where+ q = kquery (methodName m) (injectVals (methodParams m) (toBEncode arg))++getResult :: BEncode result+ => KRemote+ -> Method param result -> IO result+getResult sock m = do+ resp <- recvResponse sock+ case resp of+ Left e -> throw (RPCException e)+ Right (respVals -> dict) -> do+ case fromBEncode =<< extractArgs (methodVals m) dict of+ Right vals -> return vals+ Left e -> throw (RPCException (ProtocolError (BC.pack e)))+++-- | Makes remote procedure call. Throws RPCException on any error+-- occurred.+call :: (MonadBaseControl IO host, MonadIO host)+ => (BEncode param, BEncode result)+ => RemoteAddr -- ^ Address of callee.+ -> Method param result -- ^ Procedure to call.+ -> param -- ^ Arguments passed by callee to procedure.+ -> host result -- ^ Values returned by callee from the procedure.+call addr m arg = liftIO $ withRemote $ \sock -> do call_ sock addr m arg++-- | The same as 'call' but use already opened socket.+call_ :: (MonadBaseControl IO host, MonadIO host)+ => (BEncode param, BEncode result)+ => Remote -- ^ Socket to use+ -> RemoteAddr -- ^ Address of callee.+ -> Method param result -- ^ Procedure to call.+ -> param -- ^ Arguments passed by callee to procedure.+ -> host result -- ^ Values returned by callee from the procedure.+call_ sock addr m arg = liftIO $ do+ queryCall sock addr m arg+ getResult sock m+++type HandlerBody remote = KRemoteAddr -> KQuery -> remote (Either KError KResponse)++-- | Procedure signature and implementation binded up.+type MethodHandler remote = (MethodName, HandlerBody remote)++-- we can safely erase types in (==>)+-- | Assign method implementation to the method signature.+(==>) :: forall (remote :: * -> *) (param :: *) (result :: *).+ (BEncode param, BEncode result)+ => Monad remote+ => Method param result -- ^ Signature.+ -> (param -> remote result) -- ^ Implementation.+ -> MethodHandler remote -- ^ Handler used by server.+{-# INLINE (==>) #-}+m ==> body = m ==>@ const body+infix 1 ==>++-- | Similar to '==>@' but additionally pass caller address.+(==>@) :: forall (remote :: * -> *) (param :: *) (result :: *).+ (BEncode param, BEncode result)+ => Monad remote+ => Method param result -- ^ Signature.+ -> (KRemoteAddr -> param -> remote result) -- ^ Implementation.+ -> MethodHandler remote -- ^ Handler used by server.+{-# INLINE (==>@) #-}+m ==>@ body = (methodName m, newbody)+ where+ {-# INLINE newbody #-}+ newbody addr q =+ case fromBEncode =<< extractArgs (methodParams m) (queryArgs q) of+ Left e -> return (Left (ProtocolError (BC.pack e)))+ Right a -> do+ r <- body addr a+ return (Right (kresponse (injectVals (methodVals m) (toBEncode r))))++infix 1 ==>@++-- TODO: allow forkIO++-- | Run RPC server on specified port by using list of handlers.+-- Server will dispatch procedure specified by callee, but note that+-- it will not create new thread for each connection.+--+server :: (MonadBaseControl IO remote, MonadIO remote)+ => PortNumber -- ^ Port used to accept incoming connections.+ -> [MethodHandler remote] -- ^ Method table.+ -> remote ()+server servport handlers = do+ remoteServer servport $ \addr q -> do+ case dispatch (queryMethod q) of+ Nothing -> return $ Left $ MethodUnknown (queryMethod q)+ Just m -> m addr q+ where+ handlerMap = M.fromList handlers+ dispatch s = M.lookup s handlerMap
+ src/Network/KRPC/Protocol.hs view
@@ -0,0 +1,266 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- This module provides straightforward implementation of KRPC+-- protocol. In many situations 'Network.KRPC' should be prefered+-- since it gives more safe, convenient and high level api.+--+-- See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol>+--+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE DefaultSignatures #-}+module Network.KRPC.Protocol+ ( -- * Error+ KError(..)+ , ErrorCode+ , errorCode+ , mkKError++ -- * Query+ , KQuery(queryMethod, queryArgs)+ , MethodName+ , ParamName+ , kquery++ -- * Response+ , KResponse(respVals)+ , ValName+ , kresponse++ , sendMessage+ , recvResponse++ -- * Remote+ , KRemote+ , KRemoteAddr+ , withRemote+ , remoteServer++ -- * Re-exports+ , encode+ , encoded+ , decode+ , decoded+ , toBEncode+ , fromBEncode+ ) where++import Control.Applicative+import Control.Exception.Lifted as Lifted+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Control++import Data.BEncode+import Data.ByteString as B+import Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as LB+import Data.Map as M++import Network.Socket hiding (recvFrom)+import Network.Socket.ByteString+++-- | Errors used to signal that some error occurred while processing a+-- procedure call. Error may be send only from server to client but+-- not in the opposite direction.+--+-- Errors are encoded as bencoded dictionary:+--+-- > { "y" : "e", "e" : [<error_code>, <human_readable_error_reason>] }+--+data KError+ -- | Some error doesn't fit in any other category.+ = GenericError { errorMessage :: ByteString }++ -- | Occur when server fail to process procedure call.+ | ServerError { errorMessage :: ByteString }++ -- | Malformed packet, invalid arguments or bad token.+ | ProtocolError { errorMessage :: ByteString }++ -- | Occur when client trying to call method server don't know.+ | MethodUnknown { errorMessage :: ByteString }+ deriving (Show, Read, Eq, Ord)++instance BEncode KError where+ {-# SPECIALIZE instance BEncode KError #-}+ {-# INLINE toBEncode #-}+ toBEncode e = fromAscAssocs -- WARN: keep keys sorted+ [ "e" --> (errorCode e, errorMessage e)+ , "y" --> ("e" :: ByteString)+ ]++ {-# INLINE fromBEncode #-}+ fromBEncode (BDict d)+ | M.lookup "y" d == Just (BString "e")+ = uncurry mkKError <$> d >-- "e"++ fromBEncode _ = decodingError "KError"++type ErrorCode = Int++errorCode :: KError -> ErrorCode+errorCode (GenericError _) = 201+errorCode (ServerError _) = 202+errorCode (ProtocolError _) = 203+errorCode (MethodUnknown _) = 204+{-# INLINE errorCode #-}++mkKError :: ErrorCode -> ByteString -> KError+mkKError 201 = GenericError+mkKError 202 = ServerError+mkKError 203 = ProtocolError+mkKError 204 = MethodUnknown+mkKError _ = GenericError+{-# INLINE mkKError #-}++serverError :: SomeException -> KError+serverError = ServerError . BC.pack . show++-- TODO Asc everywhere+++type MethodName = ByteString+type ParamName = ByteString++-- | Query used to signal that caller want to make procedure call to+-- callee and pass arguments in. Therefore query may be only sent from+-- client to server but not in the opposite direction.+--+-- Queries are encoded as bencoded dictionary:+--+-- > { "y" : "q", "q" : "<method_name>", "a" : [<arg1>, <arg2>, ...] }+--+data KQuery = KQuery {+ queryMethod :: MethodName+ , queryArgs :: Map ParamName BValue+ } deriving (Show, Read, Eq, Ord)++instance BEncode KQuery where+ {-# SPECIALIZE instance BEncode KQuery #-}+ {-# INLINE toBEncode #-}+ toBEncode (KQuery m args) = fromAscAssocs -- WARN: keep keys sorted+ [ "a" --> BDict args+ , "q" --> m+ , "y" --> ("q" :: ByteString)+ ]++ {-# INLINE fromBEncode #-}+ fromBEncode (BDict d)+ | M.lookup "y" d == Just (BString "q") =+ KQuery <$> d >-- "q"+ <*> d >-- "a"++ fromBEncode _ = decodingError "KQuery"++kquery :: MethodName -> [(ParamName, BValue)] -> KQuery+kquery name args = KQuery name (M.fromList args)+{-# INLINE kquery #-}+++++type ValName = ByteString++-- | KResponse used to signal that callee successufully process a+-- procedure call and to return values from procedure. KResponse should+-- not be sent if error occurred during RPC. Thus KResponse may be only+-- sent from server to client.+--+-- Responses are encoded as bencoded dictionary:+--+-- > { "y" : "r", "r" : [<val1>, <val2>, ...] }+--+newtype KResponse = KResponse { respVals :: BDict }+ deriving (Show, Read, Eq, Ord)++instance BEncode KResponse where+ {-# INLINE toBEncode #-}+ toBEncode (KResponse vals) = fromAscAssocs -- WARN: keep keys sorted+ [ "r" --> vals+ , "y" --> ("r" :: ByteString)+ ]++ {-# INLINE fromBEncode #-}+ fromBEncode (BDict d)+ | M.lookup "y" d == Just (BString "r") =+ KResponse <$> d >-- "r"++ fromBEncode _ = decodingError "KDict"+++kresponse :: [(ValName, BValue)] -> KResponse+kresponse = KResponse . M.fromList+{-# INLINE kresponse #-}++++type KRemoteAddr = (HostAddress, PortNumber)++type KRemote = Socket++withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m a+withRemote = bracket (liftIO (socket AF_INET Datagram defaultProtocol))+ (liftIO . sClose)+{-# SPECIALIZE withRemote :: (KRemote -> IO a) -> IO a #-}+++maxMsgSize :: Int+{-# INLINE maxMsgSize #-}+-- release+--maxMsgSize = 512 -- size of payload of one udp packet+-- bench+maxMsgSize = 64 * 1024 -- max udp size+++-- TODO eliminate toStrict+sendMessage :: BEncode msg => msg -> KRemoteAddr -> KRemote -> IO ()+sendMessage msg (host, port) sock =+ sendAllTo sock (LB.toStrict (encoded msg)) (SockAddrInet port host)+{-# INLINE sendMessage #-}++recvResponse :: KRemote -> IO (Either KError KResponse)+recvResponse sock = do+ (raw, _) <- recvFrom sock maxMsgSize+ return $ case decoded raw of+ Right resp -> Right resp+ Left decE -> Left $ case decoded raw of+ Right kerror -> kerror+ _ -> ProtocolError (BC.pack decE)++-- | Run server using a given port. Method invocation should be done manually.+remoteServer :: (MonadBaseControl IO remote, MonadIO remote)+ => PortNumber -- ^ Port number to listen.+ -> (KRemoteAddr -> KQuery -> remote (Either KError KResponse))+ -- ^ Handler.+ -> remote ()+remoteServer servport action = bracket (liftIO bindServ) (liftIO . sClose) loop+ where+ bindServ = do+ sock <- socket AF_INET Datagram defaultProtocol+ bindSocket sock (SockAddrInet servport iNADDR_ANY)+ return sock++ loop sock = forever $ do+ (bs, addr) <- liftIO $ recvFrom sock maxMsgSize+ case addr of+ SockAddrInet port host -> do+ let kaddr = (host, port)+ reply <- handleMsg bs kaddr+ liftIO $ sendMessage reply kaddr sock+ _ -> return ()++ where+ handleMsg bs addr = case decoded bs of+ Right query -> (either toBEncode toBEncode <$> action addr query)+ `Lifted.catch` (return . toBEncode . serverError)+ Left decodeE -> return $ toBEncode (ProtocolError (BC.pack decodeE))
+ src/Network/KRPC/Scheme.hs view
@@ -0,0 +1,80 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- This module provides message scheme validation for core protocol+-- messages from 'Remote.KRPC.Procotol'. This module should be used+-- with 'Remote.KRPC.Protocol', otherwise (if you are using 'Remote.KRPC')+-- this module seems to be useless.+--+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+module Network.KRPC.Scheme+ ( KMessage(..)+ , KQueryScheme(..), methodQueryScheme+ , KResponseScheme(..), methodRespScheme+ ) where++import Control.Applicative+import Data.Map as M+import Data.Set as S++import Network.KRPC.Protocol+import Network.KRPC+++-- | Used to validate any message by its scheme+--+-- forall m. m `validate` scheme m+--+class KMessage message scheme | message -> scheme where+ -- | Get a message scheme.+ scheme :: message -> scheme++ -- | Check a message with a scheme.+ validate :: message -> scheme -> Bool++ default validate :: Eq scheme => message -> scheme -> Bool+ validate = (==) . scheme+ {-# INLINE validate #-}+++instance KMessage KError ErrorCode where+ {-# SPECIALIZE instance KMessage KError ErrorCode #-}+ scheme = errorCode+ {-# INLINE scheme #-}+++data KQueryScheme = KQueryScheme {+ qscMethod :: MethodName+ , qscParams :: Set ParamName+ } deriving (Show, Read, Eq, Ord)++instance KMessage KQuery KQueryScheme where+ {-# SPECIALIZE instance KMessage KQuery KQueryScheme #-}+ scheme q = KQueryScheme (queryMethod q) (M.keysSet (queryArgs q))+ {-# INLINE scheme #-}++methodQueryScheme :: Method a b -> KQueryScheme+methodQueryScheme = KQueryScheme <$> methodName+ <*> S.fromList . methodParams+{-# INLINE methodQueryScheme #-}+++newtype KResponseScheme = KResponseScheme {+ rscVals :: Set ValName+ } deriving (Show, Read, Eq, Ord)++instance KMessage KResponse KResponseScheme where+ {-# SPECIALIZE instance KMessage KResponse KResponseScheme #-}+ scheme = KResponseScheme . keysSet . respVals+ {-# INLINE scheme #-}++methodRespScheme :: Method a b -> KResponseScheme+methodRespScheme = KResponseScheme . S.fromList . methodVals+{-# INLINE methodRespScheme #-}
− src/Remote/KRPC.hs
@@ -1,362 +0,0 @@--- |--- Copyright : (c) Sam Truzjan 2013--- License : BSD3--- Maintainer : pxqr.sta@gmail.com--- Stability : experimental--- Portability : portable------ This module provides safe remote procedure call. One important--- point is exceptions and errors, so be able handle them properly--- we need to investigate a bit about how this all works.--- Internally, in order to make method invokation KRPC makes the--- following steps:------ * Caller serialize arguments to bencoded bytestrings;------ * Caller send bytestring data over UDP to the callee;------ * Callee receive and decode arguments to the method and method--- name. If it can't decode then it send 'ProtocolError' back to the--- caller;------ * Callee search for the @method name@ in the method table.--- If it not present in the table then callee send 'MethodUnknown'--- back to the caller;------ * Callee check if argument names match. If not it send--- 'ProtocolError' back;------ * Callee make the actuall call to the plain old haskell--- function. If the function throw exception then callee send--- 'ServerError' back.------ * Callee serialize result of the function to bencoded bytestring.------ * Callee encode result to bencoded bytestring and send it back--- to the caller.------ * Caller check if return values names match with the signature--- it called in the first step.------ * Caller extracts results and finally return results of the--- procedure call as ordinary haskell values.------ If every other error occurred caller get the 'GenericError'. All--- errors returned by callee are throwed as ordinary haskell--- exceptions at caller side. Make sure that both callee and caller--- uses the same method signatures and everything should be ok: this--- KRPC implementation provides some level of safety through--- types. Also note that both caller and callee use plain UDP, so--- KRPC is unreliable.------ Consider one tiny example. From now @caller = client@ and--- @callee = server or remote@.------ Somewhere we have to define all procedure signatures. Imagine--- that this is a library shared between client and server:------ > factorialMethod :: Method Int Int--- > factorialMethod = method "factorial" ["x"] ["y"]------ Otherwise you can define this code in both client and server of--- course. But in this case you might get into troubles: you can get--- 'MethodUnknown' or 'ProtocolError' if name or type of method--- will mismatch after not synced changes in client or server code.------ Now let's define our client-side:------ > main = withRemote $ \remote -> do--- > result <- call remote (0, 6000) factorialMethod 4--- > assert (result == 24) $ print "Success!"------ It basically open socket with 'withRemote' and make all the other--- steps in 'call' as describe above. And finally our server-side:------ > factorialImpl :: Int -> Int--- > factorialImpl n = product [1..n]--- >--- > main = runServer [factorialMethod $ return . factorialImpl]------ Here we implement method signature from that shared lib and run--- server with runServer by passing method table in.------ For async API use /async/ package, old API have been removed.------ For more examples see @exsamples@ or @tests@ directories.------ For protocol details see 'Remote.KRPC.Protocol' module.----{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ExplicitForAll #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveGeneric #-}-module Remote.KRPC- ( -- * Method- Method(..)- , method, idM-- -- * Client- , RemoteAddr- , RPCException(..)- , call-- -- * Server- , MethodHandler- , (==>)- , (==>@)- , server-- -- * Internal- , call_- , withRemote- ) where--import Control.Applicative-import Control.Exception-import Control.Monad.Trans.Control-import Control.Monad.IO.Class-import Data.BEncode-import Data.ByteString.Char8 as BC-import Data.List as L-import Data.Map as M-import Data.Monoid-import Data.Typeable-import Network-import GHC.Generics--import Remote.KRPC.Protocol----- | Method datatype used to describe name, parameters and return--- values of procedure. Client use a method to /invoke/, server--- /implements/ the method to make the actual work.------ We use the following fantom types to ensure type-safiety:------ * param: Type of method parameters. Ordinary Tuple type used--- to specify more than one parameter, so for example @Method--- (Int, Int) result@ will take two arguments.------ * result: Type of return value of the method. Similarly,--- tuple used to specify more than one return value, so for--- exsample @Method (Foo, Bar) (Bar, Foo)@ will take two arguments--- and return two values.------ To pass raw dictionaries you should specify empty param list:------ > method "my_method" [] [] :: Method BEncode BEncode------ In this case you should handle dictionary extraction by hand, both--- in client and server.----data Method param result = Method {- -- | Name used in query.- methodName :: MethodName-- -- | Name of each parameter in /right to left/ order.- , methodParams :: [ParamName]-- -- | Name of each return value in /right to left/ order.- , methodVals :: [ValName]- } deriving (Eq, Ord, Generic)--instance BEncodable (Method a b)--instance (Typeable a, Typeable b) => Show (Method a b) where- showsPrec _ = showsMethod--showsMethod- :: forall a. forall b.- Typeable a => Typeable b- => Method a b -> ShowS-showsMethod Method {..} =- showString (BC.unpack methodName) <>- showString " :: " <>- showsTuple methodParams paramsTy <>- showString " -> " <>- showsTuple methodVals valuesTy- where- paramsTy = typeOf (error "KRPC.showsMethod: impossible" :: a)- valuesTy = typeOf (error "KRPC.showsMethod: impossible" :: b)-- showsTuple ns ty- = showChar '('- <> mconcat (L.intersperse (showString ", ") $- L.zipWith showsTyArgName ns (detuple ty))- <> showChar ')'-- showsTyArgName ns ty- = showString (BC.unpack ns)- <> showString " :: "- <> showString (show ty)-- detuple tyRep- | L.null args = [tyRep]- | otherwise = args- where- args = typeRepArgs tyRep----- | Identity procedure signature. Could be used for echo--- servers. Implemented as:------ > idM = method "id" ["x"] ["y"]----idM :: Method a a-idM = method "id" ["x"] ["y"]-{-# INLINE idM #-}---- | Makes method signature. Note that order of parameters and return--- values are not important as long as corresponding names and types--- are match. For exsample this is the equal definitions:------ > methodA : Method (Foo, Bar) (Baz, Quux)--- > methodA = method "mymethod" ["a", "b"] ["c", "d"]------ > methodA : Method (Bar, Foo) (Quux, Baz)--- > methodB = method "mymethod" ["b", "a"] ["d", "c"]----method :: MethodName -> [ParamName] -> [ValName] -> Method param result-method = Method-{-# INLINE method #-}--lookupKey :: ParamName -> Map ByteString BEncode -> Result BEncode-lookupKey x = maybe (Left ("not found key " ++ BC.unpack x)) Right . M.lookup x--extractArgs :: [ParamName] -> Map ParamName BEncode -> Result BEncode-extractArgs [] d = Right $ if M.null d then BList [] else BDict d-extractArgs [x] d = lookupKey x d-extractArgs xs d = BList <$> mapM (`lookupKey` d) xs-{-# INLINE extractArgs #-}--injectVals :: [ParamName] -> BEncode -> [(ParamName, BEncode)]-injectVals [] (BList []) = []-injectVals [] (BDict d ) = M.toList d-injectVals [] be = invalidParamList [] be-injectVals [p] arg = [(p, arg)]-injectVals ps (BList as) = L.zip ps as-injectVals ps be = invalidParamList ps be-{-# INLINE injectVals #-}--invalidParamList :: [ParamName] -> BEncode -> a-invalidParamList pl be- = error $ "KRPC invalid parameter list: " ++ show pl ++ "\n" ++- "while procedure args are: " ++ show be---- | Alias to Socket, through might change in future.-type Remote = Socket---- | Represent any error mentioned by protocol specification that--- 'call', 'await' might throw.--- For more details see 'Remote.KRPC.Protocol'.----data RPCException = RPCException KError- deriving (Show, Eq, Typeable)--instance Exception RPCException---- | Address of remote can be called by client.-type RemoteAddr = KRemoteAddr--queryCall :: BEncodable param- => KRemote -> KRemoteAddr- -> Method param result -> param -> IO ()-queryCall sock addr m arg = sendMessage q addr sock- where- q = kquery (methodName m) (injectVals (methodParams m) (toBEncode arg))--getResult :: BEncodable result- => KRemote- -> Method param result -> IO result-getResult sock m = do- resp <- recvResponse sock- case resp of- Left e -> throw (RPCException e)- Right (respVals -> dict) -> do- case fromBEncode =<< extractArgs (methodVals m) dict of- Right vals -> return vals- Left e -> throw (RPCException (ProtocolError (BC.pack e)))----- | Makes remote procedure call. Throws RPCException on any error--- occurred.-call :: (MonadBaseControl IO host, MonadIO host)- => (BEncodable param, BEncodable result)- => RemoteAddr -- ^ Address of callee.- -> Method param result -- ^ Procedure to call.- -> param -- ^ Arguments passed by callee to procedure.- -> host result -- ^ Values returned by callee from the procedure.-call addr m arg = liftIO $ withRemote $ \sock -> do call_ sock addr m arg---- | The same as 'call' but use already opened socket.-call_ :: (MonadBaseControl IO host, MonadIO host)- => (BEncodable param, BEncodable result)- => Remote -- ^ Socket to use- -> RemoteAddr -- ^ Address of callee.- -> Method param result -- ^ Procedure to call.- -> param -- ^ Arguments passed by callee to procedure.- -> host result -- ^ Values returned by callee from the procedure.-call_ sock addr m arg = liftIO $ do- queryCall sock addr m arg- getResult sock m---type HandlerBody remote = KRemoteAddr -> KQuery -> remote (Either KError KResponse)---- | Procedure signature and implementation binded up.-type MethodHandler remote = (MethodName, HandlerBody remote)---- we can safely erase types in (==>)--- | Assign method implementation to the method signature.-(==>) :: forall (remote :: * -> *) (param :: *) (result :: *).- (BEncodable param, BEncodable result)- => Monad remote- => Method param result -- ^ Signature.- -> (param -> remote result) -- ^ Implementation.- -> MethodHandler remote -- ^ Handler used by server.-{-# INLINE (==>) #-}-m ==> body = m ==>@ const body-infix 1 ==>---- | Similar to '==>@' but additionally pass caller address.-(==>@) :: forall (remote :: * -> *) (param :: *) (result :: *).- (BEncodable param, BEncodable result)- => Monad remote- => Method param result -- ^ Signature.- -> (KRemoteAddr -> param -> remote result) -- ^ Implementation.- -> MethodHandler remote -- ^ Handler used by server.-{-# INLINE (==>@) #-}-m ==>@ body = (methodName m, newbody)- where- {-# INLINE newbody #-}- newbody addr q =- case fromBEncode =<< extractArgs (methodParams m) (queryArgs q) of- Left e -> return (Left (ProtocolError (BC.pack e)))- Right a -> do- r <- body addr a- return (Right (kresponse (injectVals (methodVals m) (toBEncode r))))--infix 1 ==>@---- TODO: allow forkIO---- | Run RPC server on specified port by using list of handlers.--- Server will dispatch procedure specified by callee, but note that--- it will not create new thread for each connection.----server :: (MonadBaseControl IO remote, MonadIO remote)- => PortNumber -- ^ Port used to accept incoming connections.- -> [MethodHandler remote] -- ^ Method table.- -> remote ()-server servport handlers = do- remoteServer servport $ \addr q -> do- case dispatch (queryMethod q) of- Nothing -> return $ Left $ MethodUnknown (queryMethod q)- Just m -> m addr q- where- handlerMap = M.fromList handlers- dispatch s = M.lookup s handlerMap
− src/Remote/KRPC/Protocol.hs
@@ -1,251 +0,0 @@--- |--- Copyright : (c) Sam Truzjan 2013--- License : BSD3--- Maintainer : pxqr.sta@gmail.com--- Stability : experimental--- Portability : portable------ This module provides straightforward implementation of KRPC--- protocol. In many situations 'Network.KRPC' should be prefered--- since it gives more safe, convenient and high level api.------ > See http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol----{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE DefaultSignatures #-}-module Remote.KRPC.Protocol- ( -- * Error- KError(..), ErrorCode, errorCode, mkKError-- -- * Query- , KQuery(queryMethod, queryArgs), MethodName, ParamName, kquery-- -- * Response- , KResponse(respVals), ValName, kresponse-- , sendMessage, recvResponse-- -- * Remote- , KRemote, KRemoteAddr, withRemote, remoteServer-- -- * Re-exports- , encode, encoded, decode, decoded, toBEncode, fromBEncode- ) where--import Control.Applicative-import Control.Exception.Lifted as Lifted-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.Trans.Control--import Data.BEncode-import Data.ByteString as B-import Data.ByteString.Char8 as BC-import qualified Data.ByteString.Lazy as LB-import Data.Map as M--import Network.Socket hiding (recvFrom)-import Network.Socket.ByteString----- | Errors used to signal that some error occurred while processing a--- procedure call. Error may be send only from server to client but--- not in the opposite direction.------ Errors are encoded as bencoded dictionary:------ > { "y" : "e", "e" : [<error_code>, <human_readable_error_reason>] }----data KError- -- | Some error doesn't fit in any other category.- = GenericError { errorMessage :: ByteString }-- -- | Occur when server fail to process procedure call.- | ServerError { errorMessage :: ByteString }-- -- | Malformed packet, invalid arguments or bad token.- | ProtocolError { errorMessage :: ByteString }-- -- | Occur when client trying to call method server don't know.- | MethodUnknown { errorMessage :: ByteString }- deriving (Show, Read, Eq, Ord)--instance BEncodable KError where- {-# SPECIALIZE instance BEncodable KError #-}- {-# INLINE toBEncode #-}- toBEncode e = fromAscAssocs -- WARN: keep keys sorted- [ "e" --> (errorCode e, errorMessage e)- , "y" --> ("e" :: ByteString)- ]-- {-# INLINE fromBEncode #-}- fromBEncode (BDict d)- | M.lookup "y" d == Just (BString "e")- = uncurry mkKError <$> d >-- "e"-- fromBEncode _ = decodingError "KError"--type ErrorCode = Int--errorCode :: KError -> ErrorCode-errorCode (GenericError _) = 201-errorCode (ServerError _) = 202-errorCode (ProtocolError _) = 203-errorCode (MethodUnknown _) = 204-{-# INLINE errorCode #-}--mkKError :: ErrorCode -> ByteString -> KError-mkKError 201 = GenericError-mkKError 202 = ServerError-mkKError 203 = ProtocolError-mkKError 204 = MethodUnknown-mkKError _ = GenericError-{-# INLINE mkKError #-}--serverError :: SomeException -> KError-serverError = ServerError . BC.pack . show---- TODO Asc everywhere---type MethodName = ByteString-type ParamName = ByteString---- | Query used to signal that caller want to make procedure call to--- callee and pass arguments in. Therefore query may be only sent from--- client to server but not in the opposite direction.------ Queries are encoded as bencoded dictionary:------ > { "y" : "q", "q" : "<method_name>", "a" : [<arg1>, <arg2>, ...] }----data KQuery = KQuery {- queryMethod :: MethodName- , queryArgs :: Map ParamName BEncode- } deriving (Show, Read, Eq, Ord)--instance BEncodable KQuery where- {-# SPECIALIZE instance BEncodable KQuery #-}- {-# INLINE toBEncode #-}- toBEncode (KQuery m args) = fromAscAssocs -- WARN: keep keys sorted- [ "a" --> BDict args- , "q" --> m- , "y" --> ("q" :: ByteString)- ]-- {-# INLINE fromBEncode #-}- fromBEncode (BDict d)- | M.lookup "y" d == Just (BString "q") =- KQuery <$> d >-- "q"- <*> d >-- "a"-- fromBEncode _ = decodingError "KQuery"--kquery :: MethodName -> [(ParamName, BEncode)] -> KQuery-kquery name args = KQuery name (M.fromList args)-{-# INLINE kquery #-}-----type ValName = ByteString---- | KResponse used to signal that callee successufully process a--- procedure call and to return values from procedure. KResponse should--- not be sent if error occurred during RPC. Thus KResponse may be only--- sent from server to client.------ Responses are encoded as bencoded dictionary:------ > { "y" : "r", "r" : [<val1>, <val2>, ...] }----newtype KResponse = KResponse {- respVals :: Map ValName BEncode- } deriving (Show, Read, Eq, Ord)--instance BEncodable KResponse where- {-# SPECIALIZE instance BEncodable KResponse #-}- {-# INLINE toBEncode #-}- toBEncode (KResponse vals) = fromAscAssocs -- WARN: keep keys sorted- [ "r" --> vals- , "y" --> ("r" :: ByteString)- ]-- {-# INLINE fromBEncode #-}- fromBEncode (BDict d)- | M.lookup "y" d == Just (BString "r") =- KResponse <$> d >-- "r"-- fromBEncode _ = decodingError "KDict"---kresponse :: [(ValName, BEncode)] -> KResponse-kresponse = KResponse . M.fromList-{-# INLINE kresponse #-}----type KRemoteAddr = (HostAddress, PortNumber)--type KRemote = Socket--withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m a-withRemote = bracket (liftIO (socket AF_INET Datagram defaultProtocol))- (liftIO . sClose)-{-# SPECIALIZE withRemote :: (KRemote -> IO a) -> IO a #-}---maxMsgSize :: Int-{-# INLINE maxMsgSize #-}--- release---maxMsgSize = 512 -- size of payload of one udp packet--- bench-maxMsgSize = 64 * 1024 -- max udp size----- TODO eliminate toStrict-sendMessage :: BEncodable msg => msg -> KRemoteAddr -> KRemote -> IO ()-sendMessage msg (host, port) sock =- sendAllTo sock (LB.toStrict (encoded msg)) (SockAddrInet port host)-{-# INLINE sendMessage #-}--recvResponse :: KRemote -> IO (Either KError KResponse)-recvResponse sock = do- (raw, _) <- recvFrom sock maxMsgSize- return $ case decoded raw of- Right resp -> Right resp- Left decE -> Left $ case decoded raw of- Right kerror -> kerror- _ -> ProtocolError (BC.pack decE)---- | Run server using a given port. Method invocation should be done manually.-remoteServer :: (MonadBaseControl IO remote, MonadIO remote)- => PortNumber -- ^ Port number to listen.- -> (KRemoteAddr -> KQuery -> remote (Either KError KResponse))- -- ^ Handler.- -> remote ()-remoteServer servport action = bracket (liftIO bindServ) (liftIO . sClose) loop- where- bindServ = do- sock <- socket AF_INET Datagram defaultProtocol- bindSocket sock (SockAddrInet servport iNADDR_ANY)- return sock-- loop sock = forever $ do- (bs, addr) <- liftIO $ recvFrom sock maxMsgSize- case addr of- SockAddrInet port host -> do- let kaddr = (host, port)- reply <- handleMsg bs kaddr- liftIO $ sendMessage reply kaddr sock- _ -> return ()-- where- handleMsg bs addr = case decoded bs of- Right query -> (either toBEncode toBEncode <$> action addr query)- `Lifted.catch` (return . toBEncode . serverError)- Left decodeE -> return $ toBEncode (ProtocolError (BC.pack decodeE))
− src/Remote/KRPC/Scheme.hs
@@ -1,80 +0,0 @@--- |--- Copyright : (c) Sam Truzjan 2013--- License : BSD3--- Maintainer : pxqr.sta@gmail.com--- Stability : experimental--- Portability : portable------ This module provides message scheme validation for core protocol--- messages from 'Remote.KRPC.Procotol'. This module should be used--- with 'Remote.KRPC.Protocol', otherwise (if you are using 'Remote.KRPC')--- this module seems to be useless.----{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-module Remote.KRPC.Scheme- ( KMessage(..)- , KQueryScheme(..), methodQueryScheme- , KResponseScheme(..), methodRespScheme- ) where--import Control.Applicative-import Data.Map as M-import Data.Set as S--import Remote.KRPC.Protocol-import Remote.KRPC----- | Used to validate any message by its scheme------ forall m. m `validate` scheme m----class KMessage message scheme | message -> scheme where- -- | Get a message scheme.- scheme :: message -> scheme-- -- | Check a message with a scheme.- validate :: message -> scheme -> Bool-- default validate :: Eq scheme => message -> scheme -> Bool- validate = (==) . scheme- {-# INLINE validate #-}---instance KMessage KError ErrorCode where- {-# SPECIALIZE instance KMessage KError ErrorCode #-}- scheme = errorCode- {-# INLINE scheme #-}---data KQueryScheme = KQueryScheme {- qscMethod :: MethodName- , qscParams :: Set ParamName- } deriving (Show, Read, Eq, Ord)--instance KMessage KQuery KQueryScheme where- {-# SPECIALIZE instance KMessage KQuery KQueryScheme #-}- scheme q = KQueryScheme (queryMethod q) (M.keysSet (queryArgs q))- {-# INLINE scheme #-}--methodQueryScheme :: Method a b -> KQueryScheme-methodQueryScheme = KQueryScheme <$> methodName- <*> S.fromList . methodParams-{-# INLINE methodQueryScheme #-}---newtype KResponseScheme = KResponseScheme {- rscVals :: Set ValName- } deriving (Show, Read, Eq, Ord)--instance KMessage KResponse KResponseScheme where- {-# SPECIALIZE instance KMessage KResponse KResponseScheme #-}- scheme = KResponseScheme . keysSet . respVals- {-# INLINE scheme #-}--methodRespScheme :: Method a b -> KResponseScheme-methodRespScheme = KResponseScheme . S.fromList . methodVals-{-# INLINE methodRespScheme #-}
tests/Client.hs view
@@ -14,7 +14,7 @@ import Test.Framework import Test.Framework.Providers.HUnit -import Remote.KRPC+import Network.KRPC import Shared
tests/Server.hs view
@@ -2,7 +2,7 @@ module Main (main) where import Data.BEncode-import Remote.KRPC+import Network.KRPC import Shared
@@ -12,7 +12,7 @@ import Data.ByteString (ByteString) import Data.BEncode-import Remote.KRPC+import Network.KRPC unitM :: Method () () unitM = method "unit" [] []@@ -32,8 +32,8 @@ shiftR :: Method ((), Int, [Int]) ([Int], (), Int) shiftR = method "shiftR" ["x", "y", "z"] ["a", "b", "c"] -rawM :: Method BEncode BEncode+rawM :: Method BValue BValue rawM = method "rawM" [""] [""] -rawDictM :: Method BEncode BEncode+rawDictM :: Method BValue BValue rawDictM = method "m" [] []