summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.md4
-rw-r--r--bench/Main.hs3
-rw-r--r--bench/Server.hs3
-rw-r--r--krpc.cabal4
-rw-r--r--src/Network/KRPC.hs9
-rw-r--r--src/Network/KRPC/Protocol.hs25
-rw-r--r--tests/Client.hs3
-rw-r--r--tests/Server.hs3
8 files changed, 29 insertions, 25 deletions
diff --git a/README.md b/README.md
index ccbd6789..189bda04 100644
--- a/README.md
+++ b/README.md
@@ -13,6 +13,10 @@ language, thus it's hard to shoot yourself in the foot accidently.
13See bittorrent DHT [specification][spec] for detailed protocol 13See bittorrent DHT [specification][spec] for detailed protocol
14description. 14description.
15 15
16### Example
17
18TODO
19
16#### Modules 20#### Modules
17 21
18* Remote.KRPC — simple interface which reduce all RPC related stuff to 22* Remote.KRPC — simple interface which reduce all RPC related stuff to
diff --git a/bench/Main.hs b/bench/Main.hs
index fdf76cc2..024d4d93 100644
--- a/bench/Main.hs
+++ b/bench/Main.hs
@@ -6,10 +6,11 @@ import Data.ByteString (ByteString)
6import qualified Data.ByteString as B 6import qualified Data.ByteString as B
7import Criterion.Main 7import Criterion.Main
8import Network.KRPC 8import Network.KRPC
9import Network.Socket
9 10
10 11
11addr :: RemoteAddr 12addr :: RemoteAddr
12addr = (0, 6000) 13addr = SockAddrInet 6000 0
13 14
14echo :: Method ByteString ByteString 15echo :: Method ByteString ByteString
15echo = method "echo" ["x"] ["x"] 16echo = method "echo" ["x"] ["x"]
diff --git a/bench/Server.hs b/bench/Server.hs
index 444362c1..ef20c08a 100644
--- a/bench/Server.hs
+++ b/bench/Server.hs
@@ -3,10 +3,11 @@ module Main (main) where
3 3
4import Data.ByteString (ByteString) 4import Data.ByteString (ByteString)
5import Network.KRPC 5import Network.KRPC
6import Network.Socket
6 7
7 8
8echo :: Method ByteString ByteString 9echo :: Method ByteString ByteString
9echo = method "echo" ["x"] ["x"] 10echo = method "echo" ["x"] ["x"]
10 11
11main :: IO () 12main :: IO ()
12main = server 6000 [ echo ==> return ] 13main = server (SockAddrInet 6000 0) [ echo ==> return ]
diff --git a/krpc.cabal b/krpc.cabal
index d6995410..9929cea7 100644
--- a/krpc.cabal
+++ b/krpc.cabal
@@ -69,6 +69,7 @@ test-suite test-client
69 69
70 , bencoding 70 , bencoding
71 , krpc 71 , krpc
72 , network
72 73
73 , HUnit 74 , HUnit
74 , test-framework 75 , test-framework
@@ -84,6 +85,7 @@ executable test-server
84 , bytestring 85 , bytestring
85 , bencoding 86 , bencoding
86 , krpc 87 , krpc
88 , network
87 89
88executable bench-server 90executable bench-server
89 default-language: Haskell2010 91 default-language: Haskell2010
@@ -92,6 +94,7 @@ executable bench-server
92 build-depends: base == 4.* 94 build-depends: base == 4.*
93 , bytestring 95 , bytestring
94 , krpc 96 , krpc
97 , network
95 ghc-options: -fforce-recomp 98 ghc-options: -fforce-recomp
96 99
97benchmark bench-client 100benchmark bench-client
@@ -103,4 +106,5 @@ benchmark bench-client
103 , bytestring 106 , bytestring
104 , criterion 107 , criterion
105 , krpc 108 , krpc
109 , network
106 ghc-options: -O2 -fforce-recomp \ No newline at end of file 110 ghc-options: -O2 -fforce-recomp \ No newline at end of file
diff --git a/src/Network/KRPC.hs b/src/Network/KRPC.hs
index e667853a..3c9f9bee 100644
--- a/src/Network/KRPC.hs
+++ b/src/Network/KRPC.hs
@@ -97,7 +97,8 @@
97module Network.KRPC 97module Network.KRPC
98 ( -- * Method 98 ( -- * Method
99 Method(..) 99 Method(..)
100 , method, idM 100 , method
101 , idM
101 102
102 -- * Client 103 -- * Client
103 , RemoteAddr 104 , RemoteAddr
@@ -349,11 +350,11 @@ infix 1 ==>@
349-- it will not create new thread for each connection. 350-- it will not create new thread for each connection.
350-- 351--
351server :: (MonadBaseControl IO remote, MonadIO remote) 352server :: (MonadBaseControl IO remote, MonadIO remote)
352 => PortNumber -- ^ Port used to accept incoming connections. 353 => KRemoteAddr -- ^ Port used to accept incoming connections.
353 -> [MethodHandler remote] -- ^ Method table. 354 -> [MethodHandler remote] -- ^ Method table.
354 -> remote () 355 -> remote ()
355server servport handlers = do 356server servAddr handlers = do
356 remoteServer servport $ \addr q -> do 357 remoteServer servAddr $ \addr q -> do
357 case dispatch (queryMethod q) of 358 case dispatch (queryMethod q) of
358 Nothing -> return $ Left $ MethodUnknown (queryMethod q) 359 Nothing -> return $ Left $ MethodUnknown (queryMethod q)
359 Just m -> m addr q 360 Just m -> m addr q
diff --git a/src/Network/KRPC/Protocol.hs b/src/Network/KRPC/Protocol.hs
index ad1dabca..2d905f06 100644
--- a/src/Network/KRPC/Protocol.hs
+++ b/src/Network/KRPC/Protocol.hs
@@ -202,10 +202,7 @@ kresponse :: [(ValName, BValue)] -> KResponse
202kresponse = KResponse . M.fromList 202kresponse = KResponse . M.fromList
203{-# INLINE kresponse #-} 203{-# INLINE kresponse #-}
204 204
205 205type KRemoteAddr = SockAddr
206
207type KRemoteAddr = (HostAddress, PortNumber)
208
209type KRemote = Socket 206type KRemote = Socket
210 207
211withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m a 208withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m a
@@ -224,8 +221,7 @@ maxMsgSize = 64 * 1024 -- max udp size
224 221
225-- TODO eliminate toStrict 222-- TODO eliminate toStrict
226sendMessage :: BEncode msg => msg -> KRemoteAddr -> KRemote -> IO () 223sendMessage :: BEncode msg => msg -> KRemoteAddr -> KRemote -> IO ()
227sendMessage msg (host, port) sock = 224sendMessage msg addr sock = sendAllTo sock (LB.toStrict (encoded msg)) addr
228 sendAllTo sock (LB.toStrict (encoded msg)) (SockAddrInet port host)
229{-# INLINE sendMessage #-} 225{-# INLINE sendMessage #-}
230 226
231recvResponse :: KRemote -> IO (Either KError KResponse) 227recvResponse :: KRemote -> IO (Either KError KResponse)
@@ -239,26 +235,21 @@ recvResponse sock = do
239 235
240-- | Run server using a given port. Method invocation should be done manually. 236-- | Run server using a given port. Method invocation should be done manually.
241remoteServer :: (MonadBaseControl IO remote, MonadIO remote) 237remoteServer :: (MonadBaseControl IO remote, MonadIO remote)
242 => PortNumber -- ^ Port number to listen. 238 => KRemoteAddr -- ^ Port number to listen.
243 -> (KRemoteAddr -> KQuery -> remote (Either KError KResponse)) 239 -> (KRemoteAddr -> KQuery -> remote (Either KError KResponse))
244 -- ^ Handler. 240 -- ^ Handler.
245 -> remote () 241 -> remote ()
246remoteServer servport action = bracket (liftIO bindServ) (liftIO . sClose) loop 242remoteServer servAddr action = bracket (liftIO bindServ) (liftIO . sClose) loop
247 where 243 where
248 bindServ = do 244 bindServ = do
249 sock <- socket AF_INET Datagram defaultProtocol 245 sock <- socket AF_INET Datagram defaultProtocol
250 bindSocket sock (SockAddrInet servport iNADDR_ANY) 246 bindSocket sock servAddr
251 return sock 247 return sock
252 248
253 loop sock = forever $ do 249 loop sock = forever $ do
254 (bs, addr) <- liftIO $ recvFrom sock maxMsgSize 250 (bs, addr) <- liftIO $ recvFrom sock maxMsgSize
255 case addr of 251 reply <- handleMsg bs addr
256 SockAddrInet port host -> do 252 liftIO $ sendMessage reply addr sock
257 let kaddr = (host, port)
258 reply <- handleMsg bs kaddr
259 liftIO $ sendMessage reply kaddr sock
260 _ -> return ()
261
262 where 253 where
263 handleMsg bs addr = case decoded bs of 254 handleMsg bs addr = case decoded bs of
264 Right query -> (either toBEncode toBEncode <$> action addr query) 255 Right query -> (either toBEncode toBEncode <$> action addr query)
diff --git a/tests/Client.hs b/tests/Client.hs
index db7a3219..cda01631 100644
--- a/tests/Client.hs
+++ b/tests/Client.hs
@@ -15,11 +15,12 @@ import Test.Framework
15import Test.Framework.Providers.HUnit 15import Test.Framework.Providers.HUnit
16 16
17import Network.KRPC 17import Network.KRPC
18import Network.Socket
18import Shared 19import Shared
19 20
20 21
21addr :: RemoteAddr 22addr :: RemoteAddr
22addr = (0, 6000) 23addr = SockAddrInet 6000 0
23 24
24withServ :: FilePath -> IO () -> IO () 25withServ :: FilePath -> IO () -> IO ()
25withServ serv_path = bracket up terminateProcess . const 26withServ serv_path = bracket up terminateProcess . const
diff --git a/tests/Server.hs b/tests/Server.hs
index 9e70b70b..b4b34891 100644
--- a/tests/Server.hs
+++ b/tests/Server.hs
@@ -3,11 +3,12 @@ module Main (main) where
3 3
4import Data.BEncode 4import Data.BEncode
5import Network.KRPC 5import Network.KRPC
6import Network.Socket
6import Shared 7import Shared
7 8
8 9
9main :: IO () 10main :: IO ()
10main = server 6000 11main = server (SockAddrInet 6000 0)
11 [ unitM ==> return 12 [ unitM ==> return
12 , echoM ==> return 13 , echoM ==> return
13 , echoBytes ==> return 14 , echoBytes ==> return