/src/System/ZMQ4/Monadic.hs
Haskell | 624 lines | 425 code | 134 blank | 65 comment | 1 complexity | b7ab9bc202c77cbde1d533cbbd437501 MD5 | raw file
1{-# LANGUAGE RankNTypes #-} 2{-# LANGUAGE GeneralizedNewtypeDeriving #-} 3{-# LANGUAGE MultiParamTypeClasses #-} 4{-# LANGUAGE TypeFamilies #-} 5{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 6 7-- | 8-- Module : System.ZMQ4.Monadic 9-- Copyright : (c) 2013 Toralf Wittner 10-- License : MIT 11-- Maintainer : Toralf Wittner <tw@dtex.org> 12-- Stability : experimental 13-- Portability : non-portable 14-- 15-- This modules exposes a monadic interface of 'System.ZMQ4'. Actions run 16-- inside a 'ZMQ' monad and 'Socket's are guaranteed not to leak outside 17-- their corresponding 'runZMQ' scope. Running 'ZMQ' computations 18-- asynchronously is directly supported through 'async'. 19module System.ZMQ4.Monadic 20 ( -- * Type Definitions 21 ZMQ 22 , Socket 23 , Z.Flag (..) 24 , Z.Switch (..) 25 , Z.Timeout 26 , Z.Event (..) 27 , Z.EventType (..) 28 , Z.EventMsg (..) 29 , Z.Poll (..) 30 , Z.KeyFormat (..) 31 , Z.SecurityMechanism (..) 32 33 -- ** Socket type-classes 34 , Z.SocketType 35 , Z.Sender 36 , Z.Receiver 37 , Z.Subscriber 38 , Z.SocketLike 39 , Z.Conflatable 40 , Z.SendProbe 41 42 -- ** Socket Types 43 , Z.Pair (..) 44 , Z.Pub (..) 45 , Z.Sub (..) 46 , Z.XPub (..) 47 , Z.XSub (..) 48 , Z.Req (..) 49 , Z.Rep (..) 50 , Z.Dealer (..) 51 , Z.Router (..) 52 , Z.Pull (..) 53 , Z.Push (..) 54 , Z.Stream (..) 55 56 -- * General Operations 57 , version 58 , runZMQ 59 , async 60 , socket 61 62 -- * ZMQ Options (Read) 63 , ioThreads 64 , maxSockets 65 66 -- * ZMQ Options (Write) 67 , setIoThreads 68 , setMaxSockets 69 70 -- * Socket operations 71 , close 72 , bind 73 , unbind 74 , connect 75 , disconnect 76 , send 77 , send' 78 , sendMulti 79 , receive 80 , receiveMulti 81 , subscribe 82 , unsubscribe 83 , proxy 84 , monitor 85 , socketMonitor 86 , Z.poll 87 88 -- * Socket Options (Read) 89 , affinity 90 , backlog 91 , conflate 92 , curvePublicKey 93 , curveSecretKey 94 , curveServerKey 95 , delayAttachOnConnect 96 , events 97 , fileDescriptor 98 , identity 99 , immediate 100 , ipv4Only 101 , ipv6 102 , lastEndpoint 103 , linger 104 , maxMessageSize 105 , mcastHops 106 , mechanism 107 , moreToReceive 108 , plainServer 109 , plainPassword 110 , plainUserName 111 , rate 112 , receiveBuffer 113 , receiveHighWM 114 , receiveTimeout 115 , reconnectInterval 116 , reconnectIntervalMax 117 , recoveryInterval 118 , sendBuffer 119 , sendHighWM 120 , sendTimeout 121 , tcpKeepAlive 122 , tcpKeepAliveCount 123 , tcpKeepAliveIdle 124 , tcpKeepAliveInterval 125 , zapDomain 126 127 -- * Socket Options (Write) 128 , setAffinity 129 , setBacklog 130 , setConflate 131 , setCurveServer 132 , setCurvePublicKey 133 , setCurveSecretKey 134 , setCurveServerKey 135 , setDelayAttachOnConnect 136 , setIdentity 137 , setImmediate 138 , setIpv4Only 139 , setIpv6 140 , setLinger 141 , setMaxMessageSize 142 , setMcastHops 143 , setPlainServer 144 , setPlainPassword 145 , setPlainUserName 146 , setProbeRouter 147 , setRate 148 , setReceiveBuffer 149 , setReceiveHighWM 150 , setReceiveTimeout 151 , setReconnectInterval 152 , setReconnectIntervalMax 153 , setRecoveryInterval 154 , setReqCorrelate 155 , setReqRelaxed 156 , setRouterMandatory 157 , setSendBuffer 158 , setSendHighWM 159 , setSendTimeout 160 , setTcpAcceptFilter 161 , setTcpKeepAlive 162 , setTcpKeepAliveCount 163 , setTcpKeepAliveIdle 164 , setTcpKeepAliveInterval 165 , setXPubVerbose 166 167 -- * Error Handling 168 , Z.ZMQError 169 , Z.errno 170 , Z.source 171 , Z.message 172 173 -- * Re-exports 174 , Control.Monad.IO.Class.liftIO 175 , Data.Restricted.restrict 176 , Data.Restricted.toRestricted 177 178 -- * Low-level Functions 179 , waitRead 180 , waitWrite 181 , I.z85Encode 182 , I.z85Decode 183 , Z.curveKeyPair 184 ) where 185 186import Control.Applicative 187import Control.Concurrent.Async (Async) 188import Control.Monad 189import Control.Monad.Base (MonadBase(..)) 190import Control.Monad.Catch 191import Control.Monad.IO.Class 192import Control.Monad.Trans.Control (MonadBaseControl(..)) 193import Control.Monad.Trans.Reader 194import Data.Int 195import Data.IORef 196import Data.List.NonEmpty (NonEmpty) 197import Data.Restricted 198import Data.Word 199import Data.ByteString (ByteString) 200import System.Posix.Types (Fd) 201import Prelude 202 203import qualified Control.Concurrent.Async as A 204import qualified Control.Exception as E 205import qualified Control.Monad.Catch as C 206import qualified Data.ByteString.Lazy as Lazy 207import qualified System.ZMQ4 as Z 208import qualified System.ZMQ4.Internal as I 209 210data ZMQEnv = ZMQEnv 211 { _refcount :: !(IORef Word) 212 , _context :: !Z.Context 213 , _sockets :: !(IORef [I.SocketRepr]) 214 } 215 216-- | The ZMQ monad is modeled after 'Control.Monad.ST' and encapsulates 217-- a 'System.ZMQ4.Context'. It uses the uninstantiated type variable 'z' to 218-- distinguish different invoctions of 'runZMQ' and to prevent 219-- unintented use of 'Socket's outside their scope. Cf. the paper 220-- of John Launchbury and Simon Peyton Jones /Lazy Functional State Threads/. 221newtype ZMQ z a = ZMQ { _unzmq :: ReaderT ZMQEnv IO a } 222 deriving (MonadBase IO) 223 224-- | The ZMQ socket, parameterised by 'SocketType' and belonging to 225-- a particular 'ZMQ' thread. 226newtype Socket z t = Socket { _unsocket :: Z.Socket t } 227 228instance I.SocketLike (Socket z) where 229 toSocket = _unsocket 230 231instance Monad (ZMQ z) where 232 return = ZMQ . return 233 (ZMQ m) >>= f = ZMQ $ m >>= _unzmq . f 234 235instance MonadIO (ZMQ z) where 236 liftIO m = ZMQ $! liftIO m 237 238instance MonadBaseControl IO (ZMQ z) where 239 type StM (ZMQ z) a = a 240 liftBaseWith = \f -> ZMQ $ liftBaseWith $ \q -> f (q . _unzmq) 241 restoreM = ZMQ . restoreM 242 243instance MonadThrow (ZMQ z) where 244 throwM = ZMQ . C.throwM 245 246instance MonadCatch (ZMQ z) where 247 catch (ZMQ m) f = ZMQ $ m `C.catch` (_unzmq . f) 248 249instance MonadMask (ZMQ z) where 250 mask a = ZMQ . ReaderT $ \env -> 251 C.mask $ \restore -> 252 let f :: forall r a . ZMQ r a -> ZMQ r a 253 f (ZMQ (ReaderT b)) = ZMQ $ ReaderT (restore . b) 254 in runReaderT (_unzmq (a $ f)) env 255 256 uninterruptibleMask a = ZMQ . ReaderT $ \env -> 257 C.uninterruptibleMask $ \restore -> 258 let f :: forall r a . ZMQ r a -> ZMQ r a 259 f (ZMQ (ReaderT b)) = ZMQ $ ReaderT (restore . b) 260 in runReaderT (_unzmq (a $ f)) env 261 262instance Functor (ZMQ z) where 263 fmap = liftM 264 265instance Applicative (ZMQ z) where 266 pure = return 267 (<*>) = ap 268 269-- | Return the value computed by the given 'ZMQ' monad. Rank-2 270-- polymorphism is used to prevent leaking of 'z'. 271-- An invocation of 'runZMQ' will internally create a 'System.ZMQ4.Context' 272-- and all actions are executed relative to this context. On finish the 273-- context will be disposed, but see 'async'. 274runZMQ :: MonadIO m => (forall z. ZMQ z a) -> m a 275runZMQ z = liftIO $ E.bracket make term (runReaderT (_unzmq z)) 276 where 277 make = ZMQEnv <$> newIORef 1 <*> Z.context <*> newIORef [] 278 279-- | Run the given 'ZMQ' computation asynchronously, i.e. this function 280-- runs the computation in a new thread using 'Control.Concurrent.Async.async'. 281-- /N.B./ reference counting is used to prolong the lifetime of the 282-- 'System.ZMQ.Context' encapsulated in 'ZMQ' as necessary, e.g.: 283-- 284-- @ 285-- runZMQ $ do 286-- s <- socket Pair 287-- async $ do 288-- liftIO (threadDelay 10000000) 289-- identity s >>= liftIO . print 290-- @ 291-- 292-- Here, 'runZMQ' will finish before the code section in 'async', but due to 293-- reference counting, the 'System.ZMQ4.Context' will only be disposed after 294-- 'async' finishes as well. 295async :: ZMQ z a -> ZMQ z (Async a) 296async z = ZMQ $ do 297 e <- ask 298 liftIO $ atomicModifyIORef (_refcount e) $ \n -> (succ n, ()) 299 liftIO . A.async $ (runReaderT (_unzmq z) e) `E.finally` term e 300 301ioThreads :: ZMQ z Word 302ioThreads = onContext Z.ioThreads 303 304setIoThreads :: Word -> ZMQ z () 305setIoThreads = onContext . Z.setIoThreads 306 307maxSockets :: ZMQ z Word 308maxSockets = onContext Z.maxSockets 309 310setMaxSockets :: Word -> ZMQ z () 311setMaxSockets = onContext . Z.setMaxSockets 312 313socket :: Z.SocketType t => t -> ZMQ z (Socket z t) 314socket t = ZMQ $ do 315 c <- asks _context 316 s <- asks _sockets 317 x <- liftIO $ I.mkSocketRepr t c 318 liftIO $ atomicModifyIORef s $ \ss -> (x:ss, ()) 319 return (Socket (I.Socket x)) 320 321version :: ZMQ z (Int, Int, Int) 322version = liftIO $! Z.version 323 324-- * Socket operations 325 326close :: Socket z t -> ZMQ z () 327close = liftIO . Z.close . _unsocket 328 329bind :: Socket z t -> String -> ZMQ z () 330bind s = liftIO . Z.bind (_unsocket s) 331 332unbind :: Socket z t -> String -> ZMQ z () 333unbind s = liftIO . Z.unbind (_unsocket s) 334 335connect :: Socket z t -> String -> ZMQ z () 336connect s = liftIO . Z.connect (_unsocket s) 337 338disconnect :: Socket z t -> String -> ZMQ z () 339disconnect s = liftIO . Z.disconnect (_unsocket s) 340 341send :: Z.Sender t => Socket z t -> [Z.Flag] -> ByteString -> ZMQ z () 342send s f = liftIO . Z.send (_unsocket s) f 343 344send' :: Z.Sender t => Socket z t -> [Z.Flag] -> Lazy.ByteString -> ZMQ z () 345send' s f = liftIO . Z.send' (_unsocket s) f 346 347sendMulti :: Z.Sender t => Socket z t -> NonEmpty ByteString -> ZMQ z () 348sendMulti s = liftIO . Z.sendMulti (_unsocket s) 349 350receive :: Z.Receiver t => Socket z t -> ZMQ z ByteString 351receive = liftIO . Z.receive . _unsocket 352 353receiveMulti :: Z.Receiver t => Socket z t -> ZMQ z [ByteString] 354receiveMulti = liftIO . Z.receiveMulti . _unsocket 355 356subscribe :: Z.Subscriber t => Socket z t -> ByteString -> ZMQ z () 357subscribe s = liftIO . Z.subscribe (_unsocket s) 358 359unsubscribe :: Z.Subscriber t => Socket z t -> ByteString -> ZMQ z () 360unsubscribe s = liftIO . Z.unsubscribe (_unsocket s) 361 362proxy :: Socket z a -> Socket z b -> Maybe (Socket z c) -> ZMQ z () 363proxy a b c = liftIO $ Z.proxy (_unsocket a) (_unsocket b) (_unsocket <$> c) 364 365monitor :: [Z.EventType] -> Socket z t -> ZMQ z (Bool -> IO (Maybe Z.EventMsg)) 366monitor es s = onContext $ \ctx -> Z.monitor es ctx (_unsocket s) 367 368socketMonitor :: [Z.EventType] -> String -> Socket z t -> ZMQ z () 369socketMonitor es addr s = liftIO $ Z.socketMonitor es addr (_unsocket s) 370 371-- * Socket Options (Read) 372 373affinity :: Socket z t -> ZMQ z Word64 374affinity = liftIO . Z.affinity . _unsocket 375 376backlog :: Socket z t -> ZMQ z Int 377backlog = liftIO . Z.backlog . _unsocket 378 379conflate :: Z.Conflatable t => Socket z t -> ZMQ z Bool 380conflate = liftIO . Z.conflate . _unsocket 381 382curvePublicKey :: Z.KeyFormat f -> Socket z t -> ZMQ z ByteString 383curvePublicKey f = liftIO . Z.curvePublicKey f . _unsocket 384 385curveSecretKey :: Z.KeyFormat f -> Socket z t -> ZMQ z ByteString 386curveSecretKey f = liftIO . Z.curveSecretKey f . _unsocket 387 388curveServerKey :: Z.KeyFormat f -> Socket z t -> ZMQ z ByteString 389curveServerKey f = liftIO . Z.curveServerKey f . _unsocket 390 391delayAttachOnConnect :: Socket z t -> ZMQ z Bool 392delayAttachOnConnect = liftIO . Z.delayAttachOnConnect . _unsocket 393{-# DEPRECATED delayAttachOnConnect "Use immediate" #-} 394 395events :: Socket z t -> ZMQ z [Z.Event] 396events = liftIO . Z.events . _unsocket 397 398fileDescriptor :: Socket z t -> ZMQ z Fd 399fileDescriptor = liftIO . Z.fileDescriptor . _unsocket 400 401identity :: Socket z t -> ZMQ z ByteString 402identity = liftIO . Z.identity . _unsocket 403 404immediate :: Socket z t -> ZMQ z Bool 405immediate = liftIO . Z.immediate . _unsocket 406 407ipv4Only :: Socket z t -> ZMQ z Bool 408ipv4Only = liftIO . Z.ipv4Only . _unsocket 409{-# DEPRECATED ipv4Only "Use ipv6" #-} 410 411ipv6 :: Socket z t -> ZMQ z Bool 412ipv6 = liftIO . Z.ipv6 . _unsocket 413 414lastEndpoint :: Socket z t -> ZMQ z String 415lastEndpoint = liftIO . Z.lastEndpoint . _unsocket 416 417linger :: Socket z t -> ZMQ z Int 418linger = liftIO . Z.linger . _unsocket 419 420maxMessageSize :: Socket z t -> ZMQ z Int64 421maxMessageSize = liftIO . Z.maxMessageSize . _unsocket 422 423mcastHops :: Socket z t -> ZMQ z Int 424mcastHops = liftIO . Z.mcastHops . _unsocket 425 426mechanism :: Socket z t -> ZMQ z Z.SecurityMechanism 427mechanism = liftIO . Z.mechanism . _unsocket 428 429moreToReceive :: Socket z t -> ZMQ z Bool 430moreToReceive = liftIO . Z.moreToReceive . _unsocket 431 432plainServer :: Socket z t -> ZMQ z Bool 433plainServer = liftIO . Z.plainServer . _unsocket 434 435plainPassword :: Socket z t -> ZMQ z ByteString 436plainPassword = liftIO . Z.plainPassword . _unsocket 437 438plainUserName :: Socket z t -> ZMQ z ByteString 439plainUserName = liftIO . Z.plainUserName . _unsocket 440 441rate :: Socket z t -> ZMQ z Int 442rate = liftIO . Z.rate . _unsocket 443 444receiveBuffer :: Socket z t -> ZMQ z Int 445receiveBuffer = liftIO . Z.receiveBuffer . _unsocket 446 447receiveHighWM :: Socket z t -> ZMQ z Int 448receiveHighWM = liftIO . Z.receiveHighWM . _unsocket 449 450receiveTimeout :: Socket z t -> ZMQ z Int 451receiveTimeout = liftIO . Z.receiveTimeout . _unsocket 452 453reconnectInterval :: Socket z t -> ZMQ z Int 454reconnectInterval = liftIO . Z.reconnectInterval . _unsocket 455 456reconnectIntervalMax :: Socket z t -> ZMQ z Int 457reconnectIntervalMax = liftIO . Z.reconnectIntervalMax . _unsocket 458 459recoveryInterval :: Socket z t -> ZMQ z Int 460recoveryInterval = liftIO . Z.recoveryInterval . _unsocket 461 462sendBuffer :: Socket z t -> ZMQ z Int 463sendBuffer = liftIO . Z.sendBuffer . _unsocket 464 465sendHighWM :: Socket z t -> ZMQ z Int 466sendHighWM = liftIO . Z.sendHighWM . _unsocket 467 468sendTimeout :: Socket z t -> ZMQ z Int 469sendTimeout = liftIO . Z.sendTimeout . _unsocket 470 471tcpKeepAlive :: Socket z t -> ZMQ z Z.Switch 472tcpKeepAlive = liftIO . Z.tcpKeepAlive . _unsocket 473 474tcpKeepAliveCount :: Socket z t -> ZMQ z Int 475tcpKeepAliveCount = liftIO . Z.tcpKeepAliveCount . _unsocket 476 477tcpKeepAliveIdle :: Socket z t -> ZMQ z Int 478tcpKeepAliveIdle = liftIO . Z.tcpKeepAliveIdle . _unsocket 479 480tcpKeepAliveInterval :: Socket z t -> ZMQ z Int 481tcpKeepAliveInterval = liftIO . Z.tcpKeepAliveInterval . _unsocket 482 483zapDomain :: Socket z t -> ZMQ z ByteString 484zapDomain = liftIO . Z.zapDomain . _unsocket 485 486-- * Socket Options (Write) 487 488setAffinity :: Word64 -> Socket z t -> ZMQ z () 489setAffinity a = liftIO . Z.setAffinity a . _unsocket 490 491setBacklog :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 492setBacklog b = liftIO . Z.setBacklog b . _unsocket 493 494setConflate :: Z.Conflatable t => Bool -> Socket z t -> ZMQ z () 495setConflate i = liftIO . Z.setConflate i . _unsocket 496 497setCurvePublicKey :: Z.KeyFormat f -> Restricted f ByteString -> Socket z t -> ZMQ z () 498setCurvePublicKey f k = liftIO . Z.setCurvePublicKey f k . _unsocket 499 500setCurveSecretKey :: Z.KeyFormat f -> Restricted f ByteString -> Socket z t -> ZMQ z () 501setCurveSecretKey f k = liftIO . Z.setCurveSecretKey f k . _unsocket 502 503setCurveServer :: Bool -> Socket z t -> ZMQ z () 504setCurveServer b = liftIO . Z.setCurveServer b . _unsocket 505 506setCurveServerKey :: Z.KeyFormat f -> Restricted f ByteString -> Socket z t -> ZMQ z () 507setCurveServerKey f k = liftIO . Z.setCurveServerKey f k . _unsocket 508 509setDelayAttachOnConnect :: Bool -> Socket z t -> ZMQ z () 510setDelayAttachOnConnect d = liftIO . Z.setDelayAttachOnConnect d . _unsocket 511{-# DEPRECATED setDelayAttachOnConnect "Use setImmediate" #-} 512 513setIdentity :: Restricted (N1, N254) ByteString -> Socket z t -> ZMQ z () 514setIdentity i = liftIO . Z.setIdentity i . _unsocket 515 516setImmediate :: Bool -> Socket z t -> ZMQ z () 517setImmediate i = liftIO . Z.setImmediate i . _unsocket 518 519setIpv4Only :: Bool -> Socket z t -> ZMQ z () 520setIpv4Only i = liftIO . Z.setIpv4Only i . _unsocket 521{-# DEPRECATED setIpv4Only "Use setIpv6" #-} 522 523setIpv6 :: Bool -> Socket z t -> ZMQ z () 524setIpv6 i = liftIO . Z.setIpv6 i . _unsocket 525 526setLinger :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 527setLinger l = liftIO . Z.setLinger l . _unsocket 528 529setMaxMessageSize :: Integral i => Restricted (Nneg1, Int64) i -> Socket z t -> ZMQ z () 530setMaxMessageSize s = liftIO . Z.setMaxMessageSize s . _unsocket 531 532setMcastHops :: Integral i => Restricted (N1, Int32) i -> Socket z t -> ZMQ z () 533setMcastHops k = liftIO . Z.setMcastHops k . _unsocket 534 535setPlainServer :: Bool -> Socket z t -> ZMQ z () 536setPlainServer b = liftIO . Z.setPlainServer b . _unsocket 537 538setPlainPassword :: Restricted (N1, N254) ByteString -> Socket z t -> ZMQ z () 539setPlainPassword s = liftIO . Z.setPlainPassword s . _unsocket 540 541setPlainUserName :: Restricted (N1, N254) ByteString -> Socket z t -> ZMQ z () 542setPlainUserName s = liftIO . Z.setPlainUserName s . _unsocket 543 544setProbeRouter :: Z.SendProbe t => Bool -> Socket z t -> ZMQ z () 545setProbeRouter b = liftIO . Z.setProbeRouter b . _unsocket 546 547setRate :: Integral i => Restricted (N1, Int32) i -> Socket z t -> ZMQ z () 548setRate r = liftIO . Z.setRate r . _unsocket 549 550setReceiveBuffer :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 551setReceiveBuffer k = liftIO . Z.setReceiveBuffer k . _unsocket 552 553setReceiveHighWM :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 554setReceiveHighWM k = liftIO . Z.setReceiveHighWM k . _unsocket 555 556setReceiveTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 557setReceiveTimeout t = liftIO . Z.setReceiveTimeout t . _unsocket 558 559setReconnectInterval :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 560setReconnectInterval i = liftIO . Z.setReconnectInterval i . _unsocket 561 562setReconnectIntervalMax :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 563setReconnectIntervalMax i = liftIO . Z.setReconnectIntervalMax i . _unsocket 564 565setRecoveryInterval :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 566setRecoveryInterval i = liftIO . Z.setRecoveryInterval i . _unsocket 567 568setReqCorrelate :: Bool -> Socket z Z.Req -> ZMQ z () 569setReqCorrelate b = liftIO . Z.setReqCorrelate b . _unsocket 570 571setReqRelaxed :: Bool -> Socket z Z.Req -> ZMQ z () 572setReqRelaxed b = liftIO . Z.setReqRelaxed b . _unsocket 573 574setRouterMandatory :: Bool -> Socket z Z.Router -> ZMQ z () 575setRouterMandatory b = liftIO . Z.setRouterMandatory b . _unsocket 576 577setSendBuffer :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 578setSendBuffer i = liftIO . Z.setSendBuffer i . _unsocket 579 580setSendHighWM :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 581setSendHighWM i = liftIO . Z.setSendHighWM i . _unsocket 582 583setSendTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 584setSendTimeout i = liftIO . Z.setSendTimeout i . _unsocket 585 586setTcpAcceptFilter :: Maybe ByteString -> Socket z t -> ZMQ z () 587setTcpAcceptFilter s = liftIO . Z.setTcpAcceptFilter s . _unsocket 588 589setTcpKeepAlive :: Z.Switch -> Socket z t -> ZMQ z () 590setTcpKeepAlive s = liftIO . Z.setTcpKeepAlive s . _unsocket 591 592setTcpKeepAliveCount :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 593setTcpKeepAliveCount c = liftIO . Z.setTcpKeepAliveCount c . _unsocket 594 595setTcpKeepAliveIdle :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 596setTcpKeepAliveIdle i = liftIO . Z.setTcpKeepAliveIdle i . _unsocket 597 598setTcpKeepAliveInterval :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 599setTcpKeepAliveInterval i = liftIO . Z.setTcpKeepAliveInterval i . _unsocket 600 601setXPubVerbose :: Bool -> Socket z Z.XPub -> ZMQ z () 602setXPubVerbose b = liftIO . Z.setXPubVerbose b . _unsocket 603 604-- * Low Level Functions 605 606waitRead :: Socket z t -> ZMQ z () 607waitRead = liftIO . Z.waitRead . _unsocket 608 609waitWrite :: Socket z t -> ZMQ z () 610waitWrite = liftIO . Z.waitWrite . _unsocket 611 612-- * Internal 613 614onContext :: (Z.Context -> IO a) -> ZMQ z a 615onContext f = ZMQ $! asks _context >>= liftIO . f 616 617term :: ZMQEnv -> IO () 618term env = do 619 n <- atomicModifyIORef (_refcount env) $ \n -> (pred n, n) 620 when (n == 1) $ do 621 readIORef (_sockets env) >>= mapM_ close' 622 Z.term (_context env) 623 where 624 close' s = I.closeSock s `E.catch` (\e -> print (e :: E.SomeException))