diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -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. diff --git a/NEWS.md b/NEWS.md deleted file mode 100644 --- a/NEWS.md +++ /dev/null @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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"] diff --git a/bench/Server.hs b/bench/Server.hs --- a/bench/Server.hs +++ b/bench/Server.hs @@ -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 ] diff --git a/krpc.cabal b/krpc.cabal --- a/krpc.cabal +++ b/krpc.cabal @@ -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 diff --git a/src/Network/KRPC.hs b/src/Network/KRPC.hs --- a/src/Network/KRPC.hs +++ b/src/Network/KRPC.hs @@ -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 diff --git a/src/Network/KRPC/Protocol.hs b/src/Network/KRPC/Protocol.hs --- a/src/Network/KRPC/Protocol.hs +++ b/src/Network/KRPC/Protocol.hs @@ -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) diff --git a/tests/Client.hs b/tests/Client.hs --- a/tests/Client.hs +++ b/tests/Client.hs @@ -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 diff --git a/tests/Server.hs b/tests/Server.hs --- a/tests/Server.hs +++ b/tests/Server.hs @@ -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