nanomsg-haskell 0.2.4 → 0.2.5

raw patch · 6 files changed

+154/−118 lines, 6 filesdep +tastydep +tasty-quickcheckdep −test-frameworkdep −test-framework-quickcheck2dep −test-framework-thdep ~binarydep ~bytestringnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tasty, tasty-quickcheck

Dependencies removed: test-framework, test-framework-quickcheck2, test-framework-th

Dependency ranges changed: binary, bytestring

API changes (from Hackage documentation)

Files

• changelog +9/−0
• nanomsg-haskell.cabal +15/−27
• src/Nanomsg.hsc +28/−6
• tests/BinaryProperties.hs +41/−42
• tests/Main.hs +20/−0
• tests/Properties.hs +41/−43

@@ -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

@@ -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 <ben@smart-cactus.org> 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

@@ -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.

@@ -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+    ] 

@@ -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+

@@ -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+    ]