diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,9 +1,18 @@ +0.2.5 + * Deprecate `NN_LINGER` option + * Improve testsuite reliability + * Add support for `NN_RCVMAXSIZE` option + * Fixed bug in nonblocking send where `threadWaitWrite` was used instead of + `threadWaitRead` + 0.2.4 * Bumped upper bound on binary + 0.2.3 * Switched to safe ffi calls to play better with the runtime * Tests fixed for ghc 7.10 * Some minor tweaks to docs and metadata + 0.2.2 * Added a thin Binary based serialization layer * Benchmarks now depend on ZMQ4 diff --git a/nanomsg-haskell.cabal b/nanomsg-haskell.cabal --- a/nanomsg-haskell.cabal +++ b/nanomsg-haskell.cabal @@ -1,5 +1,5 @@ name: nanomsg-haskell -version: 0.2.4 +version: 0.2.5 synopsis: Bindings to the nanomsg library description: @@ -16,13 +16,17 @@ license: MIT license-file: LICENSE author: Ivar Nymoen -maintainer: ivar dot nymoen at gmail dot com +maintainer: Ben Gamari copyright: Copyright (c) 2013 the nanomsg-haskell authors category: Network build-type: Simple cabal-version: >=1.10 tested-with: - GHC == 7.10.2 + GHC == 9.4.7, + GHC == 9.6.5, + GHC == 9.8.2, + GHC == 9.10.1, + GHC == 9.12.2 extra-source-files: README.md , CONTRIBUTORS @@ -42,39 +46,23 @@ extra-libraries: nanomsg build-depends: base >= 4.5 && < 5, - bytestring >= 0.9.0 && < 0.11, + bytestring >= 0.9.0 && < 0.13, binary >= 0.7 && < 0.9 test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests - main-is: Properties.hs + main-is: Main.hs + other-modules: BinaryProperties Properties ghc-options: -O2 -Wall -fwarn-tabs -threaded "-with-rtsopts=-N" -rtsopts default-language: Haskell2010 build-depends: base >= 4.5 && < 5, - bytestring >= 0.9.0 && < 0.11, + bytestring >= 0.9.0 && < 0.13, nanomsg-haskell, QuickCheck, - test-framework, - test-framework-quickcheck2, - test-framework-th - -test-suite tests-binary - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: BinaryProperties.hs - ghc-options: -O2 -Wall -fwarn-tabs -threaded "-with-rtsopts=-N" -rtsopts - default-language: Haskell2010 - build-depends: - base >= 4.5 && < 5, - bytestring >= 0.9.0 && < 0.11, - nanomsg-haskell, - binary, - QuickCheck, - test-framework, - test-framework-quickcheck2, - test-framework-th + tasty, + tasty-quickcheck source-repository head type: git @@ -88,7 +76,7 @@ hs-source-dirs: benchmarks build-depends: base >= 4.5 && < 5, - bytestring >= 0.9.0 && < 0.11, + bytestring >= 0.9.0 && < 0.13, nanomsg-haskell, criterion @@ -100,7 +88,7 @@ hs-source-dirs: benchmarks build-depends: base >= 4.5 && < 5, - bytestring >= 0.9.0 && < 0.11, + bytestring >= 0.9.0 && < 0.13, nanomsg-haskell, zeromq4-haskell, criterion diff --git a/src/Nanomsg.hsc b/src/Nanomsg.hsc --- a/src/Nanomsg.hsc +++ b/src/Nanomsg.hsc @@ -59,6 +59,8 @@ , setSndBuf , rcvBuf , setRcvBuf + , rcvMaxSize + , setRcvMaxSize , reconnectInterval , setReconnectInterval , reconnectIntervalMax @@ -344,11 +346,11 @@ -- NN_EXPORT int nn_send (int s, const void *buf, size_t len, int flags); foreign import ccall safe "nn.h nn_send" - c_nn_send :: CInt -> CString -> CInt -> CInt -> IO CInt + c_nn_send :: CInt -> CString -> CSize -> CInt -> IO CInt -- NN_EXPORT int nn_recv (int s, void *buf, size_t len, int flags); foreign import ccall safe "nn.h nn_recv" - c_nn_recv :: CInt -> Ptr CString -> CInt -> CInt -> IO CInt + c_nn_recv :: CInt -> Ptr CString -> CSize -> CInt -> IO CInt -- NN_EXPORT int nn_freemsg (void *msg); foreign import ccall safe "nn.h nn_freemsg" @@ -364,11 +366,11 @@ -- NN_EXPORT int nn_setsockopt (int s, int level, int option, const void *optval, size_t optvallen); foreign import ccall safe "nn.h nn_setsockopt" - c_nn_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CInt -> IO CInt + c_nn_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CSize -> IO CInt -- NN_EXPORT int nn_getsockopt (int s, int level, int option, void *optval, size_t *optvallen); foreign import ccall safe "nn.h nn_getsockopt" - c_nn_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt + c_nn_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CSize -> IO CInt -- /* Resolves system errors and native errors to human-readable string. */ -- NN_EXPORT const char *nn_strerror (int errnum); @@ -467,7 +469,7 @@ throwErrnoIfMinus1RetryMayBlock_ "send" (c_nn_send sid ptr (fromIntegral len) (#const NN_DONTWAIT)) - (getOptionFd (Socket t sid) (#const NN_SNDFD) >>= threadWaitWrite) + (getOptionFd (Socket t sid) (#const NN_SNDFD) >>= threadWaitRead) -- | Blocking receive. recv :: Receiver a => Socket a -> IO ByteString @@ -535,7 +537,7 @@ setOption (Socket _ sid) level option (IntOption val) = alloca $ \ptr -> do poke ptr (fromIntegral val :: CInt) - let cintSize = fromIntegral $ sizeOf (fromIntegral val :: CInt) :: CInt + let cintSize = fromIntegral $ sizeOf (fromIntegral val :: CInt) :: CSize throwErrnoIfMinus1_ "setOption (int)" $ c_nn_setsockopt sid level option ptr cintSize setOption (Socket _ sid) level option (StringOption str) = @@ -575,6 +577,7 @@ linger :: Socket a -> IO Int linger s = fromIntegral <$> getOption s (#const NN_SOL_SOCKET) (#const NN_LINGER) +{-# DEPRECATED linger "NN_LINGER is no longer supported by nanomsg" #-} -- | Specifies how long should the socket try to send pending outbound -- messages after close has been called, in milliseconds. @@ -583,6 +586,7 @@ setLinger :: Socket a -> Int -> IO () setLinger s val = setOption s (#const NN_SOL_SOCKET) (#const NN_LINGER) (IntOption val) +{-# DEPRECATED setLinger "NN_LINGER is no longer supported by nanomsg" #-} -- | Size of the send buffer, in bytes. To prevent blocking for messages -- larger than the buffer, exactly one message may be buffered in addition @@ -619,6 +623,24 @@ setRcvBuf :: Socket a -> Int -> IO () setRcvBuf s val = setOption s (#const NN_SOL_SOCKET) (#const NN_RCVBUF) (IntOption val) + +-- | Maximum message size that can be received, in bytes. +-- Negative value means that the received size is limited only by available addressable memory. +-- The type of this option is int. +-- +-- Default is 1024kB. +rcvMaxSize :: Socket a -> IO Int +rcvMaxSize s = + fromIntegral <$> getOption s (#const NN_SOL_SOCKET) (#const NN_RCVMAXSIZE) + +-- | Maximum message size that can be received, in bytes. +-- Negative value means that the received size is limited only by available addressable memory. +-- The type of this option is int. +-- +-- Default is 1024kB. +setRcvMaxSize :: Socket a -> Int -> IO () +setRcvMaxSize s val = + setOption s (#const NN_SOL_SOCKET) (#const NN_RCVMAXSIZE) (IntOption val) -- Think I'll just skip these. There's recv' for nonblocking receive, and -- adding a return value to send seems awkward. diff --git a/tests/BinaryProperties.hs b/tests/BinaryProperties.hs --- a/tests/BinaryProperties.hs +++ b/tests/BinaryProperties.hs @@ -1,12 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Main where +module BinaryProperties where import Nanomsg.Binary -import Test.Framework.TH (defaultMainGenerator) -import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck import Test.QuickCheck.Monadic +import Test.Tasty (TestTree, sequentialTestGroup, DependencyType(AllFinish)) +import Test.Tasty.QuickCheck (testProperty) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C import Control.Concurrent (threadDelay) @@ -173,45 +173,44 @@ f <- recv b2 return $ all (== msg) [a, b, c, d, e, f] -prop_TestOptions :: Property -prop_TestOptions = monadicIO $ do - res <- run $ do - req <- socket Req - _ <- bind req "tcp://*:5560" - surveyor <- socket Surveyor - _ <- bind surveyor "inproc://surveyor" - threadDelay 1000 - setTcpNoDelay req 1 - v1 <- tcpNoDelay req - setTcpNoDelay req 0 - v2 <- tcpNoDelay req - setRequestResendInterval req 30000 - v3 <- requestResendInterval req - setIpv4Only req 0 - v4 <- ipv4Only req - setIpv4Only req 1 - v5 <- ipv4Only req - setSndPrio req 7 - v6 <- sndPrio req - setReconnectInterval req 50 - v7 <- reconnectInterval req - setReconnectIntervalMax req 400 - v8 <- reconnectIntervalMax req - setRcvBuf req 200000 - v9 <- rcvBuf req - setSndBuf req 150000 - v10 <- sndBuf req - setLinger req 500 - v11 <- linger req - setSurveyorDeadline surveyor 2000 - v12 <- surveyorDeadline surveyor - close req - close surveyor +-- options +test_options :: TestTree +test_options = sequentialTestGroup "options" AllFinish + [ roundtrip "tcpNoDelay" Req tcpNoDelay setTcpNoDelay 0 + , roundtrip "requestResendInterval" Req requestResendInterval setRequestResendInterval 30000 + , roundtrip "ipv4Only0" Req ipv4Only setIpv4Only 0 + , roundtrip "ipv4Only1" Req ipv4Only setIpv4Only 1 + , roundtrip "sndPrio" Req sndPrio setSndPrio 7 + , roundtrip "reconnectInterval" Req reconnectInterval setReconnectInterval 50 + , roundtrip "reconnectIntervalMax" Req reconnectIntervalMax setReconnectIntervalMax 400 + , roundtrip "rcvBuf" Req rcvBuf setRcvBuf 200000 + , roundtrip "sndBuf" Req sndBuf setSndBuf 150000 + , roundtrip "surveyorDeadline" Surveyor surveyorDeadline setSurveyorDeadline 2000 + ] + where + roundtrip :: (Eq v, Show v, SocketType a) + => String + -> a + -> (Socket a -> IO v) + -> (Socket a -> v -> IO ()) + -> v + -> TestTree + roundtrip name sockTy get set value = testProperty name $ monadicIO $ run $ do + sock <- socket sockTy + _ <- bind sock "tcp://*:5561" threadDelay 1000 - return [v1 == 1, v2 == 0, v3 == 30000, v4 == 0, v5 == 1, v6 == 7, - v7 == 50, v8 == 400, v9 == 200000, v10 == 150000, v11 == 500, v12 == 2000] - assert $ and res + set sock value + v <- get sock + close sock + return $ value === v -main :: IO () -main = $defaultMainGenerator +tests :: TestTree +tests = sequentialTestGroup "BinaryProperties" AllFinish + [ testProperty "reverse" prop_reverse + , testProperty "PubSub" prop_PubSub + , testProperty "Pair" prop_Pair + , testProperty "Pipeline" prop_Pipeline + , testProperty "ReqRep" prop_ReqRep + , testProperty "Bus" prop_Bus + ] diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,20 @@ +import qualified Test.Tasty as T +import qualified Test.Tasty.Ingredients as T + +import qualified BinaryProperties +import qualified Properties + +tests :: T.TestTree +tests = + T.sequentialTestGroup "tests" T.AllFinish + [ Properties.tests + , BinaryProperties.tests + ] + +ingredients :: [T.Ingredient] +ingredients = T.defaultIngredients + +main :: IO () +main = do + T.defaultMainWithIngredients ingredients tests + diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,13 +1,12 @@ -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Main where +module Properties where import Nanomsg -import Test.Framework.TH (defaultMainGenerator) -import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck import Test.QuickCheck.Monadic +import Test.Tasty (TestTree, sequentialTestGroup, DependencyType(AllFinish)) +import Test.Tasty.QuickCheck (testProperty) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C import Control.Concurrent (threadDelay) @@ -168,45 +167,44 @@ f <- recv b2 return $ all (== msg) [a, b, c, d, e, f] -prop_TestOptions :: Property -prop_TestOptions = monadicIO $ do - res <- run $ do - req <- socket Req - _ <- bind req "tcp://*:5560" - surveyor <- socket Surveyor - _ <- bind surveyor "inproc://surveyor" - threadDelay 1000 - setTcpNoDelay req 1 - v1 <- tcpNoDelay req - setTcpNoDelay req 0 - v2 <- tcpNoDelay req - setRequestResendInterval req 30000 - v3 <- requestResendInterval req - setIpv4Only req 0 - v4 <- ipv4Only req - setIpv4Only req 1 - v5 <- ipv4Only req - setSndPrio req 7 - v6 <- sndPrio req - setReconnectInterval req 50 - v7 <- reconnectInterval req - setReconnectIntervalMax req 400 - v8 <- reconnectIntervalMax req - setRcvBuf req 200000 - v9 <- rcvBuf req - setSndBuf req 150000 - v10 <- sndBuf req - setLinger req 500 - v11 <- linger req - setSurveyorDeadline surveyor 2000 - v12 <- surveyorDeadline surveyor - close req - close surveyor +-- options +test_options :: TestTree +test_options = sequentialTestGroup "options" AllFinish + [ roundtrip "tcpNoDelay" Req tcpNoDelay setTcpNoDelay 0 + , roundtrip "requestResendInterval" Req requestResendInterval setRequestResendInterval 30000 + , roundtrip "ipv4Only0" Req ipv4Only setIpv4Only 0 + , roundtrip "ipv4Only1" Req ipv4Only setIpv4Only 1 + , roundtrip "sndPrio" Req sndPrio setSndPrio 7 + , roundtrip "reconnectInterval" Req reconnectInterval setReconnectInterval 50 + , roundtrip "reconnectIntervalMax" Req reconnectIntervalMax setReconnectIntervalMax 400 + , roundtrip "rcvBuf" Req rcvBuf setRcvBuf 200000 + , roundtrip "sndBuf" Req sndBuf setSndBuf 150000 + , roundtrip "surveyorDeadline" Surveyor surveyorDeadline setSurveyorDeadline 2000 + ] + where + roundtrip :: (Eq v, Show v, SocketType a) + => String + -> a + -> (Socket a -> IO v) + -> (Socket a -> v -> IO ()) + -> v + -> TestTree + roundtrip name sockTy get set value = testProperty name $ monadicIO $ run $ do + sock <- socket sockTy + _ <- bind sock "tcp://*:5560" threadDelay 1000 - return [v1 == 1, v2 == 0, v3 == 30000, v4 == 0, v5 == 1, v6 == 7, - v7 == 50, v8 == 400, v9 == 200000, v10 == 150000, v11 == 500, v12 == 2000] - assert $ and res + set sock value + v <- get sock + close sock + return $ value === v -main :: IO () -main = $defaultMainGenerator +tests :: TestTree +tests = sequentialTestGroup "Properties" AllFinish + [ testProperty "reverse" prop_reverse + , testProperty "PubSub" prop_PubSub + , testProperty "Pair" prop_Pair + , testProperty "Pipeline" prop_Pipeline + , testProperty "ReqRep" prop_ReqRep + , testProperty "Bus" prop_Bus + ]