diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,25 @@ -Copyright (c)2010, Hideyuki Tanaka - +Copyright (c) 2017-2018, The TokTok Team +Copyright (c) 2009-2010, Hideyuki Tanaka All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Hideyuki Tanaka nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the Hideyuki Tanaka nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED BY Hideyuki Tanaka ''AS IS'' AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/network-msgpack-rpc.cabal b/network-msgpack-rpc.cabal --- a/network-msgpack-rpc.cabal +++ b/network-msgpack-rpc.cabal @@ -1,5 +1,5 @@ name: network-msgpack-rpc -version: 0.0.5 +version: 0.0.6 synopsis: A MessagePack-RPC Implementation homepage: http://msgpack.org/ license: BSD3 @@ -49,11 +49,10 @@ Network.MessagePack.Types.Spec build-depends: base < 5 - , MissingH , binary , binary-conduit , bytestring - , conduit <= 1.2.13 + , conduit , conduit-extra , data-default-class , data-default-instances-base @@ -62,9 +61,10 @@ , exceptions , monad-control , mtl - , network + , network < 3 , tagged , text + , unliftio-core test-suite testsuite type: exitcode-stdio-1.0 @@ -81,5 +81,5 @@ , bytestring , hspec , mtl - , network + , network < 3 , network-msgpack-rpc diff --git a/src/Network/MessagePack/Client/Internal.hs b/src/Network/MessagePack/Client/Internal.hs --- a/src/Network/MessagePack/Client/Internal.hs +++ b/src/Network/MessagePack/Client/Internal.hs @@ -13,8 +13,10 @@ import qualified Control.Monad.State.Strict as CMS import qualified Data.Binary as Binary import qualified Data.ByteString as S -import Data.Conduit (ResumableSource, Sink, - ($$), ($$++)) +import Data.Conduit (ConduitT, + SealedConduitT, Void, + runConduit, ($$++), + (.|)) import qualified Data.Conduit.Binary as CB import Data.Conduit.Serialization.Binary (sinkGet) import Data.MessagePack (MessagePack (fromObject), @@ -33,8 +35,8 @@ -- | RPC connection type data Connection m = Connection - { connSource :: !(ResumableSource m S.ByteString) - , connSink :: !(Sink S.ByteString m ()) + { connSource :: !(SealedConduitT () S.ByteString m ()) + , connSink :: !(ConduitT S.ByteString Void m ()) , connMsgId :: !Int , connMths :: ![Text] } @@ -68,7 +70,7 @@ (rsrc', res) <- CMS.lift $ do let req = packRequest (connMths conn) (0, msgid, methodName, args) - CB.sourceLbs req $$ connSink conn + runConduit $ CB.sourceLbs req .| connSink conn connSource conn $$++ sinkGet Binary.get CMS.put conn diff --git a/src/Network/MessagePack/Server.hs b/src/Network/MessagePack/Server.hs --- a/src/Network/MessagePack/Server.hs +++ b/src/Network/MessagePack/Server.hs @@ -20,6 +20,7 @@ ) where import Control.Monad.Catch (MonadCatch) +import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Trans (MonadIO) import Control.Monad.Trans.Control (MonadBaseControl) @@ -29,7 +30,7 @@ -- | Start RPC server with a set of RPC methods. runServer - :: (MonadBaseControl IO m, MonadIO m, MonadCatch m) + :: (MonadBaseControl IO m, MonadIO m, MonadCatch m, MonadUnliftIO m) => Int -- ^ Port number -> [Method m] -- ^ list of methods -> m () diff --git a/src/Network/MessagePack/Server/Basic.hs b/src/Network/MessagePack/Server/Basic.hs --- a/src/Network/MessagePack/Server/Basic.hs +++ b/src/Network/MessagePack/Server/Basic.hs @@ -57,13 +57,16 @@ (<$>), (<|>)) import Control.Monad.Catch (MonadCatch, MonadThrow, catch, throwM) +import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Trans (MonadIO, MonadTrans, lift, liftIO) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Binary as Binary import qualified Data.ByteString as S -import Data.Conduit (ResumableSource, Sink, - ($$), ($$+), ($$++)) +import Data.Conduit (ConduitT, + SealedConduitT, Void, + runConduit, ($$+), + ($$++), (.|)) import qualified Data.Conduit.Binary as CB import Data.Conduit.Network (appSink, appSource, runGeneralTCPServer, @@ -129,8 +132,8 @@ processRequests :: (Applicative m, MonadThrow m, MonadCatch m) => [Method m] - -> ResumableSource m S.ByteString - -> Sink S.ByteString m t + -> SealedConduitT () S.ByteString m () + -> ConduitT S.ByteString Void m t -> m b processRequests methods rsrc sink = do (rsrc', res) <- @@ -143,7 +146,7 @@ lift $ getResponse methods req `catch` \(ServerError err) -> return (1, msgid, toObject err, toObject ()) - _ <- CB.sourceLbs (packResponse res) $$ sink + _ <- runConduit $ CB.sourceLbs (packResponse res) .| sink processRequests methods rsrc' sink @@ -191,7 +194,7 @@ -- | Start RPC server with a set of RPC methods. serve - :: (MonadBaseControl IO m, MonadIO m, MonadCatch m) + :: (MonadBaseControl IO m, MonadIO m, MonadCatch m, MonadUnliftIO m) => Int -- ^ Port number -> [Method m] -- ^ list of methods -> m () diff --git a/test/Network/MessagePack/ServerSpec.hs b/test/Network/MessagePack/ServerSpec.hs --- a/test/Network/MessagePack/ServerSpec.hs +++ b/test/Network/MessagePack/ServerSpec.hs @@ -8,7 +8,7 @@ import Control.Concurrent.Async (race_) import Control.Monad.Trans (liftIO) import qualified Data.ByteString as S -import Network (withSocketsDo) +import Network.Socket (withSocketsDo) import Network.MessagePack.Client (Client) import qualified Network.MessagePack.Client as Client