summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/KRPC.hs9
-rw-r--r--src/Network/KRPC/Protocol.hs25
2 files changed, 13 insertions, 21 deletions
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)