zeromq4-haskell 0.6.7 → 0.8.0
raw patch · 7 files changed
Files
- CHANGELOG.md +12/−0
- src/Data/Restricted.hs +6/−0
- src/System/ZMQ4.hs +6/−1
- src/System/ZMQ4/Internal.hs +16/−13
- src/System/ZMQ4/Monadic.hs +4/−0
- tests/System/ZMQ4/Test/Properties.hs +20/−10
- zeromq4-haskell.cabal +3/−2
CHANGELOG.md view
@@ -1,3 +1,15 @@+0.8.0+-----------------------------------------------------------------------------+- Require non-empty `ByteString`s in `setZapDomain` (#63)++0.7.0+-----------------------------------------------------------------------------+- Add `setZapDomain` (thanks to Alain O'Dea).+- `ByteString`s returned from the following socket option getters will no+ longer include the trailing NUL byte from the original C string:+ * `plainUserName`+ * `plainPassword`+ 0.6.7 ----------------------------------------------------------------------------- - Bugfix release.
src/Data/Restricted.hs view
@@ -150,6 +150,12 @@ restrict s | B.length s < 1 = Restricted (B.singleton 0x20) | otherwise = Restricted (B.take 254 s) +instance Restriction (N0, N254) ByteString where+ toRestricted s | check (0, 254) (B.length s) = Just $ Restricted s+ | otherwise = Nothing++ restrict s = Restricted (B.take 254 s)+ -- Other constraints instance Restriction Div4 ByteString where
src/System/ZMQ4.hs view
@@ -178,6 +178,7 @@ , setTcpKeepAliveIdle , setTcpKeepAliveInterval , setXPubVerbose+ , setZapDomain -- * Restrictions , Data.Restricted.restrict@@ -467,7 +468,7 @@ -- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_IDENTITY>. identity :: Socket a -> IO SB.ByteString-identity s = getByteStringOpt s B.identity+identity s = getBytesOpt s B.identity -- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_AFFINITY>. affinity :: Socket a -> IO Word64@@ -759,6 +760,10 @@ -- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_XPUB_VERBOSE>. setXPubVerbose :: Bool -> Socket XPub -> IO () setXPubVerbose x s = setIntOpt s B.xpubVerbose (bool2cint x)++-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_ZAP_DOMAIN>.+setZapDomain :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO ()+setZapDomain x s = setByteStringOpt s B.zapDomain (rvalue x) -- | Bind the socket to the given address -- (cf. <http://api.zeromq.org/4-0:zmq-bind zmq_bind>).
src/System/ZMQ4/Internal.hs view
@@ -34,6 +34,7 @@ , setInt32OptFromRestricted , ctxIntOption , setCtxIntOption+ , getBytesOpt , getByteStringOpt , setByteStringOpt @@ -62,12 +63,11 @@ import Control.Applicative import Control.Monad (foldM_, when, void) import Control.Monad.IO.Class-import Control.Exception import Data.IORef (IORef, mkWeakIORef, readIORef, atomicModifyIORef) import Foreign hiding (throwIfNull, void) import Foreign.C.String-import Foreign.C.Types (CInt, CSize)+import Foreign.C.Types (CInt) import Data.IORef (newIORef) import Data.Restricted@@ -252,26 +252,29 @@ throwIfMinus1Retry_ "setStrOpt" . withCStringLen str $ setCStrOpt s opt getIntOpt :: (Storable b, Integral b) => Socket a -> ZMQOption -> b -> IO b-getIntOpt sock (ZMQOption o) i = onSocket "getIntOpt" sock $ \s -> do- bracket (new i) free $ \iptr ->- bracket (new (fromIntegral . sizeOf $ i :: CSize)) free $ \jptr -> do- throwIfMinus1Retry_ "getIntOpt" $- c_zmq_getsockopt s (fromIntegral o) (castPtr iptr) jptr- peek iptr+getIntOpt sock (ZMQOption o) i = onSocket "getIntOpt" sock $ \s ->+ with i $ \iptr ->+ with (fromIntegral $ sizeOf i) $ \jptr -> do+ throwIfMinus1Retry_ "getIntOpt" $+ c_zmq_getsockopt s (fromIntegral o) (castPtr iptr) jptr+ peek iptr getCStrOpt :: (CStringLen -> IO s) -> Socket a -> ZMQOption -> IO s getCStrOpt peekA sock (ZMQOption o) = onSocket "getCStrOpt" sock $ \s ->- bracket (mallocBytes 255) free $ \bPtr ->- bracket (new (255 :: CSize)) free $ \sPtr -> do+ with 256 $ \nptr ->+ allocaBytes 256 $ \bptr -> do throwIfMinus1Retry_ "getCStrOpt" $- c_zmq_getsockopt s (fromIntegral o) (castPtr bPtr) sPtr- peek sPtr >>= \len -> peekA (bPtr, fromIntegral len)+ c_zmq_getsockopt s (fromIntegral o) (castPtr bptr) nptr+ peek nptr >>= \len -> peekA (bptr, fromIntegral len) getStrOpt :: Socket a -> ZMQOption -> IO String getStrOpt = getCStrOpt (peekCString . fst) getByteStringOpt :: Socket a -> ZMQOption -> IO SB.ByteString-getByteStringOpt = getCStrOpt SB.packCStringLen+getByteStringOpt = getCStrOpt (SB.packCString . fst)++getBytesOpt :: Socket a -> ZMQOption -> IO SB.ByteString+getBytesOpt = getCStrOpt SB.packCStringLen getInt32Option :: ZMQOption -> Socket a -> IO Int getInt32Option o s = fromIntegral <$> getIntOpt s o (0 :: CInt)
src/System/ZMQ4/Monadic.hs view
@@ -163,6 +163,7 @@ , setTcpKeepAliveIdle , setTcpKeepAliveInterval , setXPubVerbose+ , setZapDomain -- * Error Handling , Z.ZMQError@@ -600,6 +601,9 @@ setXPubVerbose :: Bool -> Socket z Z.XPub -> ZMQ z () setXPubVerbose b = liftIO . Z.setXPubVerbose b . _unsocket++setZapDomain :: Restricted (N1, N254) ByteString -> Socket z t -> ZMQ z ()+setZapDomain s = liftIO . Z.setZapDomain s . _unsocket -- * Low Level Functions
tests/System/ZMQ4/Test/Properties.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GADTs #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} module System.ZMQ4.Test.Properties where @@ -99,6 +98,9 @@ ReceiveTimeout val -> (ieq (rvalue val)) <$> (setReceiveTimeout val s >> receiveTimeout s) SendHighWM val -> (ieq (rvalue val)) <$> (setSendHighWM val s >> sendHighWM s) SendTimeout val -> (ieq (rvalue val)) <$> (setSendTimeout val s >> sendTimeout s)+ ZapDomain val -> (== (rvalue val)) <$> (setZapDomain val s >> zapDomain s)+ PlainPassword val -> (== (rvalue val)) <$> (setPlainPassword val s >> plainPassword s)+ PlainUsername val -> (== (rvalue val)) <$> (setPlainUserName val s >> plainUserName s) QM.assert r where ieq :: (Integral i, Integral k) => i -> k -> Bool@@ -113,15 +115,15 @@ lastEndpoint s a @=? a' -prop_subscribe :: (Subscriber a, SocketType a) => a -> ByteString -> Property-prop_subscribe t subs = monadicIO $ run $+prop_subscribe :: (Subscriber a, SocketType a) => a -> Bytes -> Property+prop_subscribe t (Bytes subs) = monadicIO $ run $ runZMQ $ do s <- socket t subscribe s subs unsubscribe s subs -prop_send_receive :: (SocketType a, SocketType b, Receiver b, Sender a) => a -> b -> ByteString -> Property-prop_send_receive a b msg = monadicIO $ do+prop_send_receive :: (SocketType a, SocketType b, Receiver b, Sender a) => a -> b -> Bytes -> Property+prop_send_receive a b (Bytes msg) = monadicIO $ do msg' <- run $ runZMQ $ do sender <- socket a receiver <- socket b@@ -132,8 +134,8 @@ liftIO $ wait x QM.assert (msg == msg') -prop_pub_sub :: (SocketType a, Subscriber b, SocketType b, Sender a, Receiver b) => a -> b -> ByteString -> Property-prop_pub_sub a b msg = monadicIO $ do+prop_pub_sub :: (SocketType a, Subscriber b, SocketType b, Sender a, Receiver b) => a -> b -> Bytes -> Property+prop_pub_sub a b (Bytes msg) = monadicIO $ do msg' <- run $ runZMQ $ do pub <- socket a sub <- socket b@@ -154,9 +156,11 @@ connect s "inproc://endpoint" disconnect s "inproc://endpoint" -instance Arbitrary ByteString where- arbitrary = CB.pack . filter (/= '\0') <$> arbitrary+newtype Bytes = Bytes { unbytes :: ByteString } deriving Show +instance Arbitrary Bytes where+ arbitrary = Bytes . CB.filter (/= '\NUL') . CB.pack <$> arbitrary+ data GetOpt = Events Int | Filedesc Fd@@ -181,6 +185,9 @@ | SendBuf (Restricted (N0, Int32) Int) | SendHighWM (Restricted (N0, Int32) Int) | SendTimeout (Restricted (Nneg1, Int32) Int)+ | ZapDomain (Restricted (N1, N254) ByteString)+ | PlainPassword (Restricted (N1, N254) ByteString)+ | PlainUsername (Restricted (N1, N254) ByteString) deriving Show instance Arbitrary GetOpt where@@ -208,7 +215,10 @@ , SendHighWM . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) , SendTimeout . toRneg1 <$> (arbitrary :: Gen Int32) `suchThat` (>= -1) , MaxMessageSize . toRneg1' <$> (arbitrary :: Gen Int64) `suchThat` (>= -1)- , Identity . fromJust . toRestricted <$> arbitrary `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)+ , ZapDomain . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)+ , PlainPassword . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)+ , PlainUsername . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255)+ , Identity . fromJust . toRestricted <$> (unbytes <$> arbitrary) `suchThat` (\s -> SB.length s > 0 && SB.length s < 255) ] toR1 :: Int32 -> Restricted (N1, Int32) Int
zeromq4-haskell.cabal view
@@ -1,5 +1,5 @@ name: zeromq4-haskell-version: 0.6.7+version: 0.8.0 synopsis: Bindings to ZeroMQ 4.x category: System, FFI license: MIT@@ -9,7 +9,7 @@ copyright: (c) 2010 - 2015 zeromq-haskell authors homepage: https://gitlab.com/twittner/zeromq-haskell/ stability: experimental-tested-With: GHC == 8.0.2+tested-With: GHC == 8.2.2 cabal-version: >= 1.8 build-type: Simple extra-source-files:@@ -77,6 +77,7 @@ hs-source-dirs: tests main-is: tests.hs ghc-options: -Wall -threaded+ other-modules: System.ZMQ4.Test.Properties build-depends: zeromq4-haskell , async