krpc 0.3.0.0 → 0.4.0.0
raw patch · 10 files changed
+53/−49 lines, 10 filesdep ~network
Dependency ranges changed: network
Files
- CHANGELOG +8/−0
- NEWS.md +0/−7
- README.md +4/−0
- bench/Main.hs +2/−1
- bench/Server.hs +2/−1
- krpc.cabal +7/−3
- src/Network/KRPC.hs +5/−6
- src/Network/KRPC/Protocol.hs +21/−29
- tests/Client.hs +2/−1
- tests/Server.hs +2/−1
+ CHANGELOG view
@@ -0,0 +1,8 @@+* 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.+* 0.4.0.0: IPv6 support.
− NEWS.md
@@ -1,7 +0,0 @@-* 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
@@ -13,6 +13,10 @@ See bittorrent DHT [specification][spec] for detailed protocol description. +### Example++TODO+ #### Modules * Remote.KRPC — simple interface which reduce all RPC related stuff to
bench/Main.hs view
@@ -6,10 +6,11 @@ import qualified Data.ByteString as B import Criterion.Main import Network.KRPC+import Network.Socket addr :: RemoteAddr-addr = (0, 6000)+addr = SockAddrInet 6000 0 echo :: Method ByteString ByteString echo = method "echo" ["x"] ["x"]
bench/Server.hs view
@@ -3,10 +3,11 @@ import Data.ByteString (ByteString) import Network.KRPC+import Network.Socket echo :: Method ByteString ByteString echo = method "echo" ["x"] ["x"] main :: IO ()-main = server 6000 [ echo ==> return ]+main = server (SockAddrInet 6000 0) [ echo ==> return ]
krpc.cabal view
@@ -1,5 +1,5 @@ name: krpc-version: 0.3.0.0+version: 0.4.0.0 license: BSD3 license-file: LICENSE author: Sam Truzjan@@ -20,7 +20,7 @@ See NEWS.md for release notes. extra-source-files: README.md- , NEWS.md+ , CHANGELOG source-repository head type: git@@ -31,7 +31,7 @@ type: git location: git://github.com/cobit/krpc.git branch: master- tag: v0.3.0.0+ tag: v0.4.0.0 library default-language: Haskell2010@@ -69,6 +69,7 @@ , bencoding , krpc+ , network , HUnit , test-framework@@ -84,6 +85,7 @@ , bytestring , bencoding , krpc+ , network executable bench-server default-language: Haskell2010@@ -92,6 +94,7 @@ build-depends: base == 4.* , bytestring , krpc+ , network ghc-options: -fforce-recomp benchmark bench-client@@ -103,4 +106,5 @@ , bytestring , criterion , krpc+ , network ghc-options: -O2 -fforce-recomp
src/Network/KRPC.hs view
@@ -97,7 +97,8 @@ module Network.KRPC ( -- * Method Method(..)- , method, idM+ , method+ , idM -- * Client , RemoteAddr@@ -342,18 +343,16 @@ 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.+ => KRemoteAddr -- ^ Port used to accept incoming connections. -> [MethodHandler remote] -- ^ Method table. -> remote ()-server servport handlers = do- remoteServer servport $ \addr q -> do+server servAddr handlers = do+ remoteServer servAddr $ \addr q -> do case dispatch (queryMethod q) of Nothing -> return $ Left $ MethodUnknown (queryMethod q) Just m -> m addr q
src/Network/KRPC/Protocol.hs view
@@ -126,9 +126,7 @@ serverError :: SomeException -> KError serverError = ServerError . BC.pack . show --- TODO Asc everywhere - type MethodName = ByteString type ParamName = ByteString @@ -202,30 +200,26 @@ kresponse = KResponse . M.fromList {-# INLINE kresponse #-} ---type KRemoteAddr = (HostAddress, PortNumber)-+type KRemoteAddr = SockAddr type KRemote = Socket +sockAddrFamily :: SockAddr -> Family+sockAddrFamily (SockAddrInet _ _ ) = AF_INET+sockAddrFamily (SockAddrInet6 _ _ _ _) = AF_INET6+sockAddrFamily (SockAddrUnix _ ) = AF_UNIX+ withRemote :: (MonadBaseControl IO m, MonadIO m) => (KRemote -> m a) -> m a-withRemote = bracket (liftIO (socket AF_INET Datagram defaultProtocol))+withRemote = bracket (liftIO (socket AF_INET6 Datagram defaultProtocol)) (liftIO . sClose) {-# SPECIALIZE withRemote :: (KRemote -> IO a) -> IO a #-} - maxMsgSize :: Int+--maxMsgSize = 512 -- release: size of payload of one udp packet+maxMsgSize = 64 * 1024 -- bench: max UDP MTU {-# 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)+sendMessage msg addr sock = sendManyTo sock (LB.toChunks (encoded msg)) addr {-# INLINE sendMessage #-} recvResponse :: KRemote -> IO (Either KError KResponse)@@ -239,26 +233,24 @@ -- | Run server using a given port. Method invocation should be done manually. remoteServer :: (MonadBaseControl IO remote, MonadIO remote)- => PortNumber -- ^ Port number to listen.+ => KRemoteAddr -- ^ Port number to listen. -> (KRemoteAddr -> KQuery -> remote (Either KError KResponse)) -- ^ Handler. -> remote ()-remoteServer servport action = bracket (liftIO bindServ) (liftIO . sClose) loop+remoteServer servAddr action = bracket (liftIO bindServ) (liftIO . sClose) loop where bindServ = do- sock <- socket AF_INET Datagram defaultProtocol- bindSocket sock (SockAddrInet servport iNADDR_ANY)- return sock+ let family = sockAddrFamily servAddr+ sock <- socket family Datagram defaultProtocol+ when (family == AF_INET6) $ do+ setSocketOption sock IPv6Only 0+ bindSocket sock servAddr+ 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 ()-+ (bs, addr) <- liftIO $ recvFrom sock maxMsgSize+ reply <- handleMsg bs addr+ liftIO $ sendMessage reply addr sock where handleMsg bs addr = case decoded bs of Right query -> (either toBEncode toBEncode <$> action addr query)
tests/Client.hs view
@@ -15,11 +15,12 @@ import Test.Framework.Providers.HUnit import Network.KRPC+import Network.Socket import Shared addr :: RemoteAddr-addr = (0, 6000)+addr = SockAddrInet 6000 0 withServ :: FilePath -> IO () -> IO () withServ serv_path = bracket up terminateProcess . const
tests/Server.hs view
@@ -3,11 +3,12 @@ import Data.BEncode import Network.KRPC+import Network.Socket import Shared main :: IO ()-main = server 6000+main = server (SockAddrInet 6000 0) [ unitM ==> return , echoM ==> return , echoBytes ==> return