{-# LANGUAGE CPP                #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}

-- |
-- Module      : System.ZMQ4
-- Copyright   : (c) 2010-2013 Toralf Wittner
-- License     : MIT
-- Maintainer  : Toralf Wittner <tw@dtex.org>
-- Stability   : experimental
-- Portability : non-portable
--
-- 0MQ haskell binding. The API closely follows the C-API of 0MQ with
-- the main difference being that sockets are typed.
--
-- /Notes/
--
-- Many option settings use a 'Restriction' to further constrain the
-- range of possible values of their integral types. For example
-- the maximum message size can be given as -1, which means no limit
-- or by greater values, which denote the message size in bytes. The
-- type of 'setMaxMessageSize' is therefore:
--
-- @setMaxMessageSize :: Integral i
--                    => Restricted (Nneg1, Int64) i
--                    -> Socket a
--                    -> IO ()@
--
-- which means any integral value in the range of @-1@ to
-- (@maxBound :: Int64@) can be given. To create a restricted
-- value from plain value, use 'toRestricted' or 'restrict'.

module System.ZMQ4
  ( -- * Type Definitions
    -- ** Socket Types
    Pair   (..)
  , Pub    (..)
  , Sub    (..)
  , XPub   (..)
  , XSub   (..)
  , Req    (..)
  , Rep    (..)
  , Dealer (..)
  , Router (..)
  , XReq
  , XRep
  , Pull   (..)
  , Push   (..)
  , Stream (..)

    -- ** Socket type-classes
  , SocketType
  , Sender
  , Receiver
  , Subscriber
  , SocketLike
  , Conflatable
  , SendProbe

    -- ** Various type definitions
  , Size
  , Context
  , Socket
  , Flag              (..)
  , Switch            (..)
  , Timeout
  , Event             (..)
  , EventType         (..)
  , EventMsg          (..)
  , Poll              (..)
  , KeyFormat         (..)
  , SecurityMechanism (..)

    -- * General Operations
  , withContext
  , withSocket
  , bind
  , unbind
  , connect
  , disconnect
  , send
  , send'
  , sendMulti
  , receive
  , receiveMulti
  , version
  , monitor
  , socketMonitor
  , poll

  , System.ZMQ4.subscribe
  , System.ZMQ4.unsubscribe

    -- * Context Options (Read)
  , ioThreads
  , maxSockets

    -- * Context Options (Write)
  , setIoThreads
  , setMaxSockets

    -- * Socket Options (Read)
  , System.ZMQ4.affinity
  , System.ZMQ4.backlog
  , System.ZMQ4.conflate
  , System.ZMQ4.curvePublicKey
  , System.ZMQ4.curveSecretKey
  , System.ZMQ4.curveServerKey
  , System.ZMQ4.delayAttachOnConnect
  , System.ZMQ4.events
  , System.ZMQ4.fileDescriptor
  , System.ZMQ4.identity
  , System.ZMQ4.immediate
  , System.ZMQ4.ipv4Only
  , System.ZMQ4.ipv6
  , System.ZMQ4.lastEndpoint
  , System.ZMQ4.linger
  , System.ZMQ4.maxMessageSize
  , System.ZMQ4.mcastHops
  , System.ZMQ4.mechanism
  , System.ZMQ4.moreToReceive
  , System.ZMQ4.plainServer
  , System.ZMQ4.plainPassword
  , System.ZMQ4.plainUserName
  , System.ZMQ4.rate
  , System.ZMQ4.receiveBuffer
  , System.ZMQ4.receiveHighWM
  , System.ZMQ4.receiveTimeout
  , System.ZMQ4.reconnectInterval
  , System.ZMQ4.reconnectIntervalMax
  , System.ZMQ4.recoveryInterval
  , System.ZMQ4.sendBuffer
  , System.ZMQ4.sendHighWM
  , System.ZMQ4.sendTimeout
  , System.ZMQ4.tcpKeepAlive
  , System.ZMQ4.tcpKeepAliveCount
  , System.ZMQ4.tcpKeepAliveIdle
  , System.ZMQ4.tcpKeepAliveInterval
  , System.ZMQ4.zapDomain

    -- * Socket Options (Write)
  , setAffinity
  , setBacklog
  , setConflate
  , setCurveServer
  , setCurvePublicKey
  , setCurveSecretKey
  , setCurveServerKey
  , setDelayAttachOnConnect
  , setIdentity
  , setImmediate
  , setIpv4Only
  , setIpv6
  , setLinger
  , setMaxMessageSize
  , setMcastHops
  , setPlainServer
  , setPlainPassword
  , setPlainUserName
  , setProbeRouter
  , setRate
  , setReceiveBuffer
  , setReceiveHighWM
  , setReceiveTimeout
  , setReconnectInterval
  , setReconnectIntervalMax
  , setRecoveryInterval
  , setReqCorrelate
  , setReqRelaxed
  , setRouterMandatory
  , setSendBuffer
  , setSendHighWM
  , setSendTimeout
  , setTcpAcceptFilter
  , setTcpKeepAlive
  , setTcpKeepAliveCount
  , setTcpKeepAliveIdle
  , setTcpKeepAliveInterval
  , setXPubVerbose
  , setZapDomain

    -- * Restrictions
  , Data.Restricted.restrict
  , Data.Restricted.toRestricted

    -- * Error Handling
  , ZMQError
  , errno
  , source
  , message

    -- * Low-level Functions
  , init
  , term
  , shutdown
  , context
  , socket
  , close
  , waitRead
  , waitWrite
  , z85Encode
  , z85Decode

    -- * Utils
  , proxy
  , curveKeyPair
  ) where

import Control.Applicative
import Control.Exception
import Control.Monad (unless)
import Control.Monad.IO.Class
import Data.List (intersect, foldl')
import Data.List.NonEmpty (NonEmpty)
import Data.Restricted
import Data.Traversable (forM)
import Data.Typeable
import Foreign hiding (throwIf, throwIf_, throwIfNull, void)
import Foreign.C.String
import Foreign.C.Types (CInt, CShort)
import System.Posix.Types (Fd(..))
import System.ZMQ4.Internal
import System.ZMQ4.Internal.Base
import System.ZMQ4.Internal.Error
import Prelude hiding (init)

import qualified Data.ByteString           as SB
import qualified Data.ByteString.Lazy      as LB
import qualified Data.List.NonEmpty        as S
import qualified Prelude                   as P
import qualified System.ZMQ4.Internal.Base as B

import GHC.Conc (threadWaitRead)
import GHC.Generics(Generic)

-----------------------------------------------------------------------------
-- Socket Types

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_PAIR>
data Pair = Pair deriving (Pair -> Pair -> Bool
(Pair -> Pair -> Bool) -> (Pair -> Pair -> Bool) -> Eq Pair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pair -> Pair -> Bool
== :: Pair -> Pair -> Bool
$c/= :: Pair -> Pair -> Bool
/= :: Pair -> Pair -> Bool
Eq, Typeable, (forall x. Pair -> Rep Pair x)
-> (forall x. Rep Pair x -> Pair) -> Generic Pair
forall x. Rep Pair x -> Pair
forall x. Pair -> Rep Pair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pair -> Rep Pair x
from :: forall x. Pair -> Rep Pair x
$cto :: forall x. Rep Pair x -> Pair
to :: forall x. Rep Pair x -> Pair
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_PUB>
data Pub = Pub deriving (Pub -> Pub -> Bool
(Pub -> Pub -> Bool) -> (Pub -> Pub -> Bool) -> Eq Pub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pub -> Pub -> Bool
== :: Pub -> Pub -> Bool
$c/= :: Pub -> Pub -> Bool
/= :: Pub -> Pub -> Bool
Eq, Typeable, (forall x. Pub -> Rep Pub x)
-> (forall x. Rep Pub x -> Pub) -> Generic Pub
forall x. Rep Pub x -> Pub
forall x. Pub -> Rep Pub x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pub -> Rep Pub x
from :: forall x. Pub -> Rep Pub x
$cto :: forall x. Rep Pub x -> Pub
to :: forall x. Rep Pub x -> Pub
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_SUB>
data Sub = Sub deriving (Sub -> Sub -> Bool
(Sub -> Sub -> Bool) -> (Sub -> Sub -> Bool) -> Eq Sub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sub -> Sub -> Bool
== :: Sub -> Sub -> Bool
$c/= :: Sub -> Sub -> Bool
/= :: Sub -> Sub -> Bool
Eq, Typeable, (forall x. Sub -> Rep Sub x)
-> (forall x. Rep Sub x -> Sub) -> Generic Sub
forall x. Rep Sub x -> Sub
forall x. Sub -> Rep Sub x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Sub -> Rep Sub x
from :: forall x. Sub -> Rep Sub x
$cto :: forall x. Rep Sub x -> Sub
to :: forall x. Rep Sub x -> Sub
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_XPUB>
data XPub = XPub deriving (XPub -> XPub -> Bool
(XPub -> XPub -> Bool) -> (XPub -> XPub -> Bool) -> Eq XPub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPub -> XPub -> Bool
== :: XPub -> XPub -> Bool
$c/= :: XPub -> XPub -> Bool
/= :: XPub -> XPub -> Bool
Eq, Typeable, (forall x. XPub -> Rep XPub x)
-> (forall x. Rep XPub x -> XPub) -> Generic XPub
forall x. Rep XPub x -> XPub
forall x. XPub -> Rep XPub x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. XPub -> Rep XPub x
from :: forall x. XPub -> Rep XPub x
$cto :: forall x. Rep XPub x -> XPub
to :: forall x. Rep XPub x -> XPub
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_XSUB>
data XSub = XSub deriving (XSub -> XSub -> Bool
(XSub -> XSub -> Bool) -> (XSub -> XSub -> Bool) -> Eq XSub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XSub -> XSub -> Bool
== :: XSub -> XSub -> Bool
$c/= :: XSub -> XSub -> Bool
/= :: XSub -> XSub -> Bool
Eq, Typeable, (forall x. XSub -> Rep XSub x)
-> (forall x. Rep XSub x -> XSub) -> Generic XSub
forall x. Rep XSub x -> XSub
forall x. XSub -> Rep XSub x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. XSub -> Rep XSub x
from :: forall x. XSub -> Rep XSub x
$cto :: forall x. Rep XSub x -> XSub
to :: forall x. Rep XSub x -> XSub
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_REQ>
data Req = Req deriving (Req -> Req -> Bool
(Req -> Req -> Bool) -> (Req -> Req -> Bool) -> Eq Req
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Req -> Req -> Bool
== :: Req -> Req -> Bool
$c/= :: Req -> Req -> Bool
/= :: Req -> Req -> Bool
Eq, Typeable, (forall x. Req -> Rep Req x)
-> (forall x. Rep Req x -> Req) -> Generic Req
forall x. Rep Req x -> Req
forall x. Req -> Rep Req x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Req -> Rep Req x
from :: forall x. Req -> Rep Req x
$cto :: forall x. Rep Req x -> Req
to :: forall x. Rep Req x -> Req
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_REP>
data Rep = Rep deriving (Rep -> Rep -> Bool
(Rep -> Rep -> Bool) -> (Rep -> Rep -> Bool) -> Eq Rep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rep -> Rep -> Bool
== :: Rep -> Rep -> Bool
$c/= :: Rep -> Rep -> Bool
/= :: Rep -> Rep -> Bool
Eq, Typeable, (forall x. Rep -> Rep Rep x)
-> (forall x. Rep Rep x -> Rep) -> Generic Rep
forall x. Rep Rep x -> Rep
forall x. Rep -> Rep Rep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Rep -> Rep Rep x
from :: forall x. Rep -> Rep Rep x
$cto :: forall x. Rep Rep x -> Rep
to :: forall x. Rep Rep x -> Rep
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_DEALER>
data Dealer = Dealer deriving (Dealer -> Dealer -> Bool
(Dealer -> Dealer -> Bool)
-> (Dealer -> Dealer -> Bool) -> Eq Dealer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dealer -> Dealer -> Bool
== :: Dealer -> Dealer -> Bool
$c/= :: Dealer -> Dealer -> Bool
/= :: Dealer -> Dealer -> Bool
Eq, Typeable, (forall x. Dealer -> Rep Dealer x)
-> (forall x. Rep Dealer x -> Dealer) -> Generic Dealer
forall x. Rep Dealer x -> Dealer
forall x. Dealer -> Rep Dealer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dealer -> Rep Dealer x
from :: forall x. Dealer -> Rep Dealer x
$cto :: forall x. Rep Dealer x -> Dealer
to :: forall x. Rep Dealer x -> Dealer
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_ROUTER>
data Router = Router deriving (Router -> Router -> Bool
(Router -> Router -> Bool)
-> (Router -> Router -> Bool) -> Eq Router
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Router -> Router -> Bool
== :: Router -> Router -> Bool
$c/= :: Router -> Router -> Bool
/= :: Router -> Router -> Bool
Eq, Typeable, (forall x. Router -> Rep Router x)
-> (forall x. Rep Router x -> Router) -> Generic Router
forall x. Rep Router x -> Router
forall x. Router -> Rep Router x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Router -> Rep Router x
from :: forall x. Router -> Rep Router x
$cto :: forall x. Rep Router x -> Router
to :: forall x. Rep Router x -> Router
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_PULL>
data Pull = Pull deriving (Pull -> Pull -> Bool
(Pull -> Pull -> Bool) -> (Pull -> Pull -> Bool) -> Eq Pull
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pull -> Pull -> Bool
== :: Pull -> Pull -> Bool
$c/= :: Pull -> Pull -> Bool
/= :: Pull -> Pull -> Bool
Eq, Typeable, (forall x. Pull -> Rep Pull x)
-> (forall x. Rep Pull x -> Pull) -> Generic Pull
forall x. Rep Pull x -> Pull
forall x. Pull -> Rep Pull x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pull -> Rep Pull x
from :: forall x. Pull -> Rep Pull x
$cto :: forall x. Rep Pull x -> Pull
to :: forall x. Rep Pull x -> Pull
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_PUSH>
data Push = Push deriving (Push -> Push -> Bool
(Push -> Push -> Bool) -> (Push -> Push -> Bool) -> Eq Push
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Push -> Push -> Bool
== :: Push -> Push -> Bool
$c/= :: Push -> Push -> Bool
/= :: Push -> Push -> Bool
Eq, Typeable, (forall x. Push -> Rep Push x)
-> (forall x. Rep Push x -> Push) -> Generic Push
forall x. Rep Push x -> Push
forall x. Push -> Rep Push x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Push -> Rep Push x
from :: forall x. Push -> Rep Push x
$cto :: forall x. Rep Push x -> Push
to :: forall x. Rep Push x -> Push
Generic)

-- | <http://api.zeromq.org/4-0:zmq-socket ZMQ_STREAM>
data Stream = Stream deriving (Stream -> Stream -> Bool
(Stream -> Stream -> Bool)
-> (Stream -> Stream -> Bool) -> Eq Stream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stream -> Stream -> Bool
== :: Stream -> Stream -> Bool
$c/= :: Stream -> Stream -> Bool
/= :: Stream -> Stream -> Bool
Eq, Typeable, (forall x. Stream -> Rep Stream x)
-> (forall x. Rep Stream x -> Stream) -> Generic Stream
forall x. Rep Stream x -> Stream
forall x. Stream -> Rep Stream x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Stream -> Rep Stream x
from :: forall x. Stream -> Rep Stream x
$cto :: forall x. Rep Stream x -> Stream
to :: forall x. Rep Stream x -> Stream
Generic)

type XReq = Dealer
{-# DEPRECATED XReq "Use Dealer" #-}

type XRep = Router
{-# DEPRECATED XRep "Use Router" #-}

-----------------------------------------------------------------------------
-- Socket Type Classifications

-- | Sockets which can 'subscribe'.
class Subscriber a

-- | Sockets which can 'send'.
class Sender a

-- | Sockets which can 'receive'.
class Receiver a

-- | Sockets which can be 'conflate'd.
class Conflatable a

-- | Sockets which can send probes (cf. 'setProbeRouter').
class SendProbe a

instance SocketType Pair where zmqSocketType :: Pair -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Pair -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
pair
instance Sender     Pair
instance Receiver   Pair

instance SocketType  Pub where zmqSocketType :: Pub -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Pub -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
pub
instance Sender      Pub
instance Conflatable Pub

instance SocketType  Sub where zmqSocketType :: Sub -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Sub -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
sub
instance Subscriber  Sub
instance Receiver    Sub
instance Conflatable Sub

instance SocketType XPub where zmqSocketType :: XPub -> ZMQSocketType
zmqSocketType = ZMQSocketType -> XPub -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
xpub
instance Sender     XPub
instance Receiver   XPub

instance SocketType XSub where zmqSocketType :: XSub -> ZMQSocketType
zmqSocketType = ZMQSocketType -> XSub -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
xsub
instance Sender     XSub
instance Receiver   XSub

instance SocketType Req where zmqSocketType :: Req -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Req -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
request
instance Sender     Req
instance Receiver   Req
instance SendProbe  Req

instance SocketType Rep where zmqSocketType :: Rep -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Rep -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
response
instance Sender     Rep
instance Receiver   Rep

instance SocketType  Dealer where zmqSocketType :: Dealer -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Dealer -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
dealer
instance Sender      Dealer
instance Receiver    Dealer
instance Conflatable Dealer
instance SendProbe   Dealer

instance SocketType Router where zmqSocketType :: Router -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Router -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
router
instance Sender     Router
instance Receiver   Router
instance SendProbe  Router

instance SocketType  Pull where zmqSocketType :: Pull -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Pull -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
pull
instance Receiver    Pull
instance Conflatable Pull

instance SocketType  Push where zmqSocketType :: Push -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Push -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
push
instance Sender      Push
instance Conflatable Push

instance SocketType Stream where zmqSocketType :: Stream -> ZMQSocketType
zmqSocketType = ZMQSocketType -> Stream -> ZMQSocketType
forall a b. a -> b -> a
const ZMQSocketType
stream
instance Sender     Stream
instance Receiver   Stream

-----------------------------------------------------------------------------

-- | Socket events.
data Event =
    In     -- ^ @ZMQ_POLLIN@ (incoming messages)
  | Out    -- ^ @ZMQ_POLLOUT@ (outgoing messages, i.e. at least 1 byte can be written)
  | Err    -- ^ @ZMQ_POLLERR@
  deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq, Eq Event
Eq Event =>
(Event -> Event -> Ordering)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Bool)
-> (Event -> Event -> Event)
-> (Event -> Event -> Event)
-> Ord Event
Event -> Event -> Bool
Event -> Event -> Ordering
Event -> Event -> Event
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Event -> Event -> Ordering
compare :: Event -> Event -> Ordering
$c< :: Event -> Event -> Bool
< :: Event -> Event -> Bool
$c<= :: Event -> Event -> Bool
<= :: Event -> Event -> Bool
$c> :: Event -> Event -> Bool
> :: Event -> Event -> Bool
$c>= :: Event -> Event -> Bool
>= :: Event -> Event -> Bool
$cmax :: Event -> Event -> Event
max :: Event -> Event -> Event
$cmin :: Event -> Event -> Event
min :: Event -> Event -> Event
Ord, ReadPrec [Event]
ReadPrec Event
Int -> ReadS Event
ReadS [Event]
(Int -> ReadS Event)
-> ReadS [Event]
-> ReadPrec Event
-> ReadPrec [Event]
-> Read Event
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Event
readsPrec :: Int -> ReadS Event
$creadList :: ReadS [Event]
readList :: ReadS [Event]
$creadPrec :: ReadPrec Event
readPrec :: ReadPrec Event
$creadListPrec :: ReadPrec [Event]
readListPrec :: ReadPrec [Event]
Read, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show)

-- | A 'Poll' value contains the object to poll (a 0MQ socket or a file
-- descriptor), the set of 'Event's which are of interest and--optionally--
-- a callback-function which is invoked iff the set of interested events
-- overlaps with the actual events.
data Poll s m where
    Sock :: s t -> [Event] -> Maybe ([Event] -> m ()) -> Poll s m
    File :: Fd -> [Event] -> Maybe ([Event] -> m ()) -> Poll s m

-- | Return the runtime version of the underlying 0MQ library as a
-- (major, minor, patch) triple.
version :: IO (Int, Int, Int)
version :: IO (Int, Int, Int)
version =
    CInt -> (Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
0 ((Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
major_ptr ->
    CInt -> (Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
0 ((Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
minor_ptr ->
    CInt -> (Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with CInt
0 ((Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CInt -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
patch_ptr ->
        Ptr CInt -> Ptr CInt -> Ptr CInt -> IO ()
c_zmq_version Ptr CInt
major_ptr Ptr CInt
minor_ptr Ptr CInt
patch_ptr IO () -> IO (Int, Int, Int) -> IO (Int, Int, Int)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        CInt -> CInt -> CInt -> (Int, Int, Int)
forall {a} {a} {a} {a} {b} {c}.
(Integral a, Integral a, Integral a, Num a, Num b, Num c) =>
a -> a -> a -> (a, b, c)
tupleUp (CInt -> CInt -> CInt -> (Int, Int, Int))
-> IO CInt -> IO (CInt -> CInt -> (Int, Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
major_ptr IO (CInt -> CInt -> (Int, Int, Int))
-> IO CInt -> IO (CInt -> (Int, Int, Int))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
minor_ptr IO (CInt -> (Int, Int, Int)) -> IO CInt -> IO (Int, Int, Int)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
patch_ptr
  where
    tupleUp :: a -> a -> a -> (a, b, c)
tupleUp a
a a
b a
c = (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b, a -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
c)

init :: Size -> IO Context
init :: Word -> IO Context
init Word
n = do
    Context
c <- IO Context
context
    Word -> Context -> IO ()
setIoThreads Word
n Context
c
    Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Context
c
{-# DEPRECATED init "Use context" #-}

-- | Initialize a 0MQ context.
-- Equivalent to <http://api.zeromq.org/4-0:zmq-ctx-new zmq_ctx_new>.
context :: IO Context
context :: IO Context
context = ZMQCtx -> Context
Context (ZMQCtx -> Context) -> IO ZMQCtx -> IO Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ZMQCtx -> IO ZMQCtx
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"init" IO ZMQCtx
c_zmq_ctx_new

-- | Terminate a 0MQ context.
-- Equivalent to <http://api.zeromq.org/4-0:zmq-ctx-term zmq_ctx_term>.
term :: Context -> IO ()
term :: Context -> IO ()
term Context
c = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"term" (IO CInt -> IO ()) -> (Context -> IO CInt) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> IO CInt
c_zmq_ctx_term (ZMQCtx -> IO CInt) -> (Context -> ZMQCtx) -> Context -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> ZMQCtx
_ctx (Context -> IO ()) -> Context -> IO ()
forall a b. (a -> b) -> a -> b
$ Context
c

-- | Shutdown a 0MQ context.
-- Equivalent to <http://api.zeromq.org/4-0:zmq-ctx-shutdown zmq_ctx_shutdown>.
shutdown :: Context -> IO ()
shutdown :: Context -> IO ()
shutdown = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1_ String
"shutdown" (IO CInt -> IO ()) -> (Context -> IO CInt) -> Context -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> IO CInt
c_zmq_ctx_shutdown (ZMQCtx -> IO CInt) -> (Context -> ZMQCtx) -> Context -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> ZMQCtx
_ctx

-- | Run an action with a 0MQ context.  The 'Context' supplied to your
-- action will /not/ be valid after the action either returns or
-- throws an exception.
withContext :: (Context -> IO a) -> IO a
withContext :: forall a. (Context -> IO a) -> IO a
withContext Context -> IO a
act =
  IO ZMQCtx -> (ZMQCtx -> IO ()) -> (ZMQCtx -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IO ZMQCtx -> IO ZMQCtx
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"withContext (new)" (IO ZMQCtx -> IO ZMQCtx) -> IO ZMQCtx -> IO ZMQCtx
forall a b. (a -> b) -> a -> b
$ IO ZMQCtx
c_zmq_ctx_new)
          (String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"withContext (term)" (IO CInt -> IO ()) -> (ZMQCtx -> IO CInt) -> ZMQCtx -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> IO CInt
c_zmq_ctx_term)
          (Context -> IO a
act (Context -> IO a) -> (ZMQCtx -> Context) -> ZMQCtx -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> Context
Context)

-- | Run an action with a 0MQ socket. The socket will be closed after running
-- the supplied action even if an error occurs. The socket supplied to your
-- action will /not/ be valid after the action terminates.
withSocket :: SocketType a => Context -> a -> (Socket a -> IO b) -> IO b
withSocket :: forall a b.
SocketType a =>
Context -> a -> (Socket a -> IO b) -> IO b
withSocket Context
c a
t = IO (Socket a) -> (Socket a -> IO ()) -> (Socket a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Context -> a -> IO (Socket a)
forall a. SocketType a => Context -> a -> IO (Socket a)
socket Context
c a
t) Socket a -> IO ()
forall a. Socket a -> IO ()
close

-- | Create a new 0MQ socket within the given context. 'withSocket' provides
-- automatic socket closing and may be safer to use.
socket :: SocketType a => Context -> a -> IO (Socket a)
socket :: forall a. SocketType a => Context -> a -> IO (Socket a)
socket Context
c a
t = SocketRepr -> Socket a
forall a. SocketRepr -> Socket a
Socket (SocketRepr -> Socket a) -> IO SocketRepr -> IO (Socket a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Context -> IO SocketRepr
forall t. SocketType t => t -> Context -> IO SocketRepr
mkSocketRepr a
t Context
c

-- | Close a 0MQ socket. 'withSocket' provides automatic socket closing and may
-- be safer to use.
close :: Socket a -> IO ()
close :: forall a. Socket a -> IO ()
close = SocketRepr -> IO ()
closeSock (SocketRepr -> IO ())
-> (Socket a -> SocketRepr) -> Socket a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket a -> SocketRepr
forall a. Socket a -> SocketRepr
_socketRepr

-- | Subscribe Socket to given subscription.
subscribe :: Subscriber a => Socket a -> SB.ByteString -> IO ()
subscribe :: forall a. Subscriber a => Socket a -> ByteString -> IO ()
subscribe Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.subscribe

-- | Unsubscribe Socket from given subscription.
unsubscribe :: Subscriber a => Socket a -> SB.ByteString -> IO ()
unsubscribe :: forall a. Subscriber a => Socket a -> ByteString -> IO ()
unsubscribe Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.unsubscribe

-- Read Only

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_EVENTS>.
events :: Socket a -> IO [Event]
events :: forall a. Socket a -> IO [Event]
events Socket a
s = Word32 -> [Event]
toEvents (Word32 -> [Event]) -> IO Word32 -> IO [Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> ZMQOption -> Word32 -> IO Word32
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO b
getIntOpt Socket a
s ZMQOption
B.events Word32
0

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_FD>.
fileDescriptor :: Socket a -> IO Fd
fileDescriptor :: forall a. Socket a -> IO Fd
fileDescriptor Socket a
s = CInt -> Fd
Fd (CInt -> Fd) -> (Int -> CInt) -> Int -> Fd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Fd) -> IO Int -> IO Fd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.filedesc Socket a
s

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RCVMORE>.
moreToReceive :: Socket a -> IO Bool
moreToReceive :: forall a. Socket a -> IO Bool
moreToReceive Socket a
s = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.receiveMore Socket a
s

-- Read

-- | <http://api.zeromq.org/4-0:zmq-ctx-get zmq_ctx_get ZMQ_IO_THREADS>.
ioThreads :: Context -> IO Word
ioThreads :: Context -> IO Word
ioThreads = String -> ZMQCtxOption -> Context -> IO Word
forall i. Integral i => String -> ZMQCtxOption -> Context -> IO i
ctxIntOption String
"ioThreads" ZMQCtxOption
_ioThreads

-- | <http://api.zeromq.org/4-0:zmq-ctx-get zmq_ctx_get ZMQ_MAX_SOCKETS>.
maxSockets :: Context -> IO Word
maxSockets :: Context -> IO Word
maxSockets = String -> ZMQCtxOption -> Context -> IO Word
forall i. Integral i => String -> ZMQCtxOption -> Context -> IO i
ctxIntOption String
"maxSockets" ZMQCtxOption
_maxSockets

-- | Restricts the outgoing and incoming socket buffers to a single message.
conflate :: Conflatable a => Socket a -> IO Bool
conflate :: forall a. Conflatable a => Socket a -> IO Bool
conflate Socket a
s = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.conflate Socket a
s

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_IMMEDIATE>.
immediate :: Socket a -> IO Bool
immediate :: forall a. Socket a -> IO Bool
immediate Socket a
s = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.immediate Socket a
s

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_IDENTITY>.
identity :: Socket a -> IO SB.ByteString
identity :: forall a. Socket a -> IO ByteString
identity Socket a
s = Socket a -> ZMQOption -> IO ByteString
forall a. Socket a -> ZMQOption -> IO ByteString
getBytesOpt Socket a
s ZMQOption
B.identity

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_AFFINITY>.
affinity :: Socket a -> IO Word64
affinity :: forall a. Socket a -> IO Word64
affinity Socket a
s = Socket a -> ZMQOption -> Word64 -> IO Word64
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO b
getIntOpt Socket a
s ZMQOption
B.affinity Word64
0

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_MAXMSGSIZE>.
maxMessageSize :: Socket a -> IO Int64
maxMessageSize :: forall a. Socket a -> IO Int64
maxMessageSize Socket a
s = Socket a -> ZMQOption -> Int64 -> IO Int64
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO b
getIntOpt Socket a
s ZMQOption
B.maxMessageSize Int64
0

ipv4Only :: Socket a -> IO Bool
ipv4Only :: forall a. Socket a -> IO Bool
ipv4Only Socket a
s = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.ipv4Only Socket a
s
{-# DEPRECATED ipv4Only "Use ipv6" #-}

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_IPV6>.
ipv6 :: Socket a -> IO Bool
ipv6 :: forall a. Socket a -> IO Bool
ipv6 Socket a
s = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.ipv6 Socket a
s

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_BACKLOG>.
backlog :: Socket a -> IO Int
backlog :: forall a. Socket a -> IO Int
backlog = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.backlog

delayAttachOnConnect :: Socket a -> IO Bool
delayAttachOnConnect :: forall a. Socket a -> IO Bool
delayAttachOnConnect Socket a
s = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> IO Int -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.delayAttachOnConnect Socket a
s
{-# DEPRECATED delayAttachOnConnect "Use immediate" #-}

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_LINGER>.
linger :: Socket a -> IO Int
linger :: forall a. Socket a -> IO Int
linger = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.linger

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_LAST_ENDPOINT>.
lastEndpoint :: Socket a -> IO String
lastEndpoint :: forall a. Socket a -> IO String
lastEndpoint Socket a
s = Socket a -> ZMQOption -> IO String
forall a. Socket a -> ZMQOption -> IO String
getStrOpt Socket a
s ZMQOption
B.lastEndpoint

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RATE>.
rate :: Socket a -> IO Int
rate :: forall a. Socket a -> IO Int
rate = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.rate

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RCVBUF>.
receiveBuffer :: Socket a -> IO Int
receiveBuffer :: forall a. Socket a -> IO Int
receiveBuffer = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.receiveBuf

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RECONNECT_IVL>.
reconnectInterval :: Socket a -> IO Int
reconnectInterval :: forall a. Socket a -> IO Int
reconnectInterval = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.reconnectIVL

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RECONNECT_IVL_MAX>.
reconnectIntervalMax :: Socket a -> IO Int
reconnectIntervalMax :: forall a. Socket a -> IO Int
reconnectIntervalMax = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.reconnectIVLMax

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RECOVERY_IVL>.
recoveryInterval :: Socket a -> IO Int
recoveryInterval :: forall a. Socket a -> IO Int
recoveryInterval = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.recoveryIVL

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_SNDBUF>.
sendBuffer :: Socket a -> IO Int
sendBuffer :: forall a. Socket a -> IO Int
sendBuffer = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.sendBuf

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_MULTICAST_HOPS>.
mcastHops :: Socket a -> IO Int
mcastHops :: forall a. Socket a -> IO Int
mcastHops = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.mcastHops

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RCVHWM>.
receiveHighWM :: Socket a -> IO Int
receiveHighWM :: forall a. Socket a -> IO Int
receiveHighWM = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.receiveHighWM

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_RCVTIMEO>.
receiveTimeout :: Socket a -> IO Int
receiveTimeout :: forall a. Socket a -> IO Int
receiveTimeout = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.receiveTimeout

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_SNDTIMEO>.
sendTimeout :: Socket a -> IO Int
sendTimeout :: forall a. Socket a -> IO Int
sendTimeout = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.sendTimeout

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_SNDHWM>.
sendHighWM :: Socket a -> IO Int
sendHighWM :: forall a. Socket a -> IO Int
sendHighWM = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.sendHighWM

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_TCP_KEEPALIVE>.
tcpKeepAlive :: Socket a -> IO Switch
tcpKeepAlive :: forall a. Socket a -> IO Switch
tcpKeepAlive = (Int -> Switch) -> IO Int -> IO Switch
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> Switch
forall a. (Show a, Integral a) => String -> a -> Switch
toSwitch String
"Invalid ZMQ_TCP_KEEPALIVE")
             (IO Int -> IO Switch)
-> (Socket a -> IO Int) -> Socket a -> IO Switch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.tcpKeepAlive

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_TCP_KEEPALIVE_CNT>.
tcpKeepAliveCount :: Socket a -> IO Int
tcpKeepAliveCount :: forall a. Socket a -> IO Int
tcpKeepAliveCount = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.tcpKeepAliveCount

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_TCP_KEEPALIVE_IDLE>.
tcpKeepAliveIdle :: Socket a -> IO Int
tcpKeepAliveIdle :: forall a. Socket a -> IO Int
tcpKeepAliveIdle = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.tcpKeepAliveIdle

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_TCP_KEEPALIVE_INTVL>.
tcpKeepAliveInterval :: Socket a -> IO Int
tcpKeepAliveInterval :: forall a. Socket a -> IO Int
tcpKeepAliveInterval = ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.tcpKeepAliveInterval

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_MECHANISM>.
mechanism :: Socket a -> IO SecurityMechanism
mechanism :: forall a. Socket a -> IO SecurityMechanism
mechanism = (Int -> SecurityMechanism) -> IO Int -> IO SecurityMechanism
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int -> SecurityMechanism
fromMechanism String
"Invalid ZMQ_MECHANISM")
          (IO Int -> IO SecurityMechanism)
-> (Socket a -> IO Int) -> Socket a -> IO SecurityMechanism
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.mechanism

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_PLAIN_SERVER>.
plainServer :: Socket a -> IO Bool
plainServer :: forall a. Socket a -> IO Bool
plainServer = (Int -> Bool) -> IO Int -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (IO Int -> IO Bool) -> (Socket a -> IO Int) -> Socket a -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.plainServer

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_PLAIN_USERNAME>.
plainUserName :: Socket a -> IO SB.ByteString
plainUserName :: forall a. Socket a -> IO ByteString
plainUserName Socket a
s = Socket a -> ZMQOption -> IO ByteString
forall a. Socket a -> ZMQOption -> IO ByteString
getByteStringOpt Socket a
s ZMQOption
B.plainUserName

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_PLAIN_PASSWORD>.
plainPassword :: Socket a -> IO SB.ByteString
plainPassword :: forall a. Socket a -> IO ByteString
plainPassword Socket a
s = Socket a -> ZMQOption -> IO ByteString
forall a. Socket a -> ZMQOption -> IO ByteString
getByteStringOpt Socket a
s ZMQOption
B.plainPassword

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_ZAP_DOMAIN>.
zapDomain :: Socket a -> IO SB.ByteString
zapDomain :: forall a. Socket a -> IO ByteString
zapDomain Socket a
s = Socket a -> ZMQOption -> IO ByteString
forall a. Socket a -> ZMQOption -> IO ByteString
getByteStringOpt Socket a
s ZMQOption
B.zapDomain

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_CURVE_PUBLICKEY>.
curvePublicKey :: KeyFormat f -> Socket a -> IO SB.ByteString
curvePublicKey :: forall f a. KeyFormat f -> Socket a -> IO ByteString
curvePublicKey KeyFormat f
f Socket a
s = KeyFormat f -> Socket a -> ZMQOption -> IO ByteString
forall f a. KeyFormat f -> Socket a -> ZMQOption -> IO ByteString
getKey KeyFormat f
f Socket a
s ZMQOption
B.curvePublicKey

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_CURVE_SERVERKEY>.
curveServerKey :: KeyFormat f -> Socket a -> IO SB.ByteString
curveServerKey :: forall f a. KeyFormat f -> Socket a -> IO ByteString
curveServerKey KeyFormat f
f Socket a
s = KeyFormat f -> Socket a -> ZMQOption -> IO ByteString
forall f a. KeyFormat f -> Socket a -> ZMQOption -> IO ByteString
getKey KeyFormat f
f Socket a
s ZMQOption
B.curveServerKey

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_CURVE_SECRETKEY>.
curveSecretKey :: KeyFormat f -> Socket a -> IO SB.ByteString
curveSecretKey :: forall f a. KeyFormat f -> Socket a -> IO ByteString
curveSecretKey KeyFormat f
f Socket a
s = KeyFormat f -> Socket a -> ZMQOption -> IO ByteString
forall f a. KeyFormat f -> Socket a -> ZMQOption -> IO ByteString
getKey KeyFormat f
f Socket a
s ZMQOption
B.curveSecretKey

-- Write

-- | <http://api.zeromq.org/4-0:zmq-ctx-set zmq_ctx_get ZMQ_IO_THREADS>.
setIoThreads :: Word -> Context -> IO ()
setIoThreads :: Word -> Context -> IO ()
setIoThreads Word
n = String -> ZMQCtxOption -> Word -> Context -> IO ()
forall i.
Integral i =>
String -> ZMQCtxOption -> i -> Context -> IO ()
setCtxIntOption String
"ioThreads" ZMQCtxOption
_ioThreads Word
n

-- | <http://api.zeromq.org/4-0:zmq-ctx-set zmq_ctx_get ZMQ_MAX_SOCKETS>.
setMaxSockets :: Word -> Context -> IO ()
setMaxSockets :: Word -> Context -> IO ()
setMaxSockets Word
n = String -> ZMQCtxOption -> Word -> Context -> IO ()
forall i.
Integral i =>
String -> ZMQCtxOption -> i -> Context -> IO ()
setCtxIntOption String
"maxSockets" ZMQCtxOption
_maxSockets Word
n

-- | Restrict the outgoing and incoming socket buffers to a single message.
setConflate :: Conflatable a => Bool -> Socket a -> IO ()
setConflate :: forall a. Conflatable a => Bool -> Socket a -> IO ()
setConflate Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.conflate (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_IMMEDIATE>.
setImmediate :: Bool -> Socket a -> IO ()
setImmediate :: forall a. Bool -> Socket a -> IO ()
setImmediate Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.immediate (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_IDENTITY>.
setIdentity :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO ()
setIdentity :: forall a. Restricted (N1, N254) ByteString -> Socket a -> IO ()
setIdentity Restricted (N1, N254) ByteString
x Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.identity (Restricted (N1, N254) ByteString -> ByteString
forall r v. Restricted r v -> v
rvalue Restricted (N1, N254) ByteString
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_AFFINITY>.
setAffinity :: Word64 -> Socket a -> IO ()
setAffinity :: forall a. Word64 -> Socket a -> IO ()
setAffinity Word64
x Socket a
s = Socket a -> ZMQOption -> Word64 -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.affinity Word64
x

setDelayAttachOnConnect :: Bool -> Socket a -> IO ()
setDelayAttachOnConnect :: forall a. Bool -> Socket a -> IO ()
setDelayAttachOnConnect Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.delayAttachOnConnect (Bool -> CInt
bool2cint Bool
x)
{-# DEPRECATED setDelayAttachOnConnect "Use setImmediate" #-}

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_MAXMSGSIZE>.
setMaxMessageSize :: Integral i => Restricted (Nneg1, Int64) i -> Socket a -> IO ()
setMaxMessageSize :: forall i a.
Integral i =>
Restricted (Nneg1, Int64) i -> Socket a -> IO ()
setMaxMessageSize Restricted (Nneg1, Int64) i
x Socket a
s = Socket a -> ZMQOption -> Int64 -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.maxMessageSize ((i -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> Int64)
-> (Restricted (Nneg1, Int64) i -> i)
-> Restricted (Nneg1, Int64) i
-> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Restricted (Nneg1, Int64) i -> i
forall r v. Restricted r v -> v
rvalue (Restricted (Nneg1, Int64) i -> Int64)
-> Restricted (Nneg1, Int64) i -> Int64
forall a b. (a -> b) -> a -> b
$ Restricted (Nneg1, Int64) i
x) :: Int64)

setIpv4Only :: Bool -> Socket a -> IO ()
setIpv4Only :: forall a. Bool -> Socket a -> IO ()
setIpv4Only Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.ipv4Only (Bool -> CInt
bool2cint Bool
x)
{-# DEPRECATED setIpv4Only "Use setIpv6" #-}

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_IPV6>.
setIpv6 :: Bool -> Socket a -> IO ()
setIpv6 :: forall a. Bool -> Socket a -> IO ()
setIpv6 Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.ipv6 (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_PLAIN_SERVER>.
setPlainServer :: Bool -> Socket a -> IO ()
setPlainServer :: forall a. Bool -> Socket a -> IO ()
setPlainServer Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.plainServer (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_CURVE_SERVER>.
setCurveServer :: Bool -> Socket a -> IO ()
setCurveServer :: forall a. Bool -> Socket a -> IO ()
setCurveServer Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.curveServer (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_PLAIN_USERNAME>.
setPlainUserName :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO ()
setPlainUserName :: forall a. Restricted (N1, N254) ByteString -> Socket a -> IO ()
setPlainUserName Restricted (N1, N254) ByteString
x Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.plainUserName (Restricted (N1, N254) ByteString -> ByteString
forall r v. Restricted r v -> v
rvalue Restricted (N1, N254) ByteString
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_PLAIN_USERNAME>.
setPlainPassword :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO ()
setPlainPassword :: forall a. Restricted (N1, N254) ByteString -> Socket a -> IO ()
setPlainPassword Restricted (N1, N254) ByteString
x Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.plainPassword (Restricted (N1, N254) ByteString -> ByteString
forall r v. Restricted r v -> v
rvalue Restricted (N1, N254) ByteString
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_LINGER>.
setLinger :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setLinger :: forall i a.
Integral i =>
Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setLinger = ZMQOption -> Restricted (Nneg1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.linger

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_RCVTIMEO>.
setReceiveTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setReceiveTimeout :: forall i a.
Integral i =>
Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setReceiveTimeout = ZMQOption -> Restricted (Nneg1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.receiveTimeout

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_ROUTER_MANDATORY>.
setRouterMandatory :: Bool -> Socket Router -> IO ()
setRouterMandatory :: Bool -> Socket Router -> IO ()
setRouterMandatory Bool
x Socket Router
s = Socket Router -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket Router
s ZMQOption
B.routerMandatory (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_SNDTIMEO>.
setSendTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setSendTimeout :: forall i a.
Integral i =>
Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setSendTimeout = ZMQOption -> Restricted (Nneg1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.sendTimeout

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_RATE>.
setRate :: Integral i => Restricted (N1, Int32) i -> Socket a -> IO ()
setRate :: forall i a.
Integral i =>
Restricted (N1, Int32) i -> Socket a -> IO ()
setRate = ZMQOption -> Restricted (N1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.rate

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_MULTICAST_HOPS>.
setMcastHops :: Integral i => Restricted (N1, Int32) i -> Socket a -> IO ()
setMcastHops :: forall i a.
Integral i =>
Restricted (N1, Int32) i -> Socket a -> IO ()
setMcastHops = ZMQOption -> Restricted (N1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.mcastHops

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_BACKLOG>.
setBacklog :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setBacklog :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setBacklog = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.backlog

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_CURVE_PUBLICKEY>.
setCurvePublicKey :: KeyFormat f -> Restricted f SB.ByteString -> Socket a -> IO ()
setCurvePublicKey :: forall f a.
KeyFormat f -> Restricted f ByteString -> Socket a -> IO ()
setCurvePublicKey KeyFormat f
_ Restricted f ByteString
k Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.curvePublicKey (Restricted f ByteString -> ByteString
forall r v. Restricted r v -> v
rvalue Restricted f ByteString
k)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_CURVE_SECRETKEY>.
setCurveSecretKey :: KeyFormat f -> Restricted f SB.ByteString -> Socket a -> IO ()
setCurveSecretKey :: forall f a.
KeyFormat f -> Restricted f ByteString -> Socket a -> IO ()
setCurveSecretKey KeyFormat f
_ Restricted f ByteString
k Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.curveSecretKey (Restricted f ByteString -> ByteString
forall r v. Restricted r v -> v
rvalue Restricted f ByteString
k)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_CURVE_SERVERKEY>.
setCurveServerKey :: KeyFormat f -> Restricted f SB.ByteString -> Socket a -> IO ()
setCurveServerKey :: forall f a.
KeyFormat f -> Restricted f ByteString -> Socket a -> IO ()
setCurveServerKey KeyFormat f
_ Restricted f ByteString
k Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.curveServerKey (Restricted f ByteString -> ByteString
forall r v. Restricted r v -> v
rvalue Restricted f ByteString
k)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_PROBE_ROUTER>.
setProbeRouter :: SendProbe a => Bool -> Socket a -> IO ()
setProbeRouter :: forall a. SendProbe a => Bool -> Socket a -> IO ()
setProbeRouter Bool
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.probeRouter (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_RCVBUF>.
setReceiveBuffer :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setReceiveBuffer :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setReceiveBuffer = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.receiveBuf

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_RECONNECT_IVL>.
setReconnectInterval :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setReconnectInterval :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setReconnectInterval = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.reconnectIVL

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_RECONNECT_IVL_MAX>.
setReconnectIntervalMax :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setReconnectIntervalMax :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setReconnectIntervalMax = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.reconnectIVLMax

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_REQ_CORRELATE>.
setReqCorrelate :: Bool -> Socket Req -> IO ()
setReqCorrelate :: Bool -> Socket Req -> IO ()
setReqCorrelate Bool
x Socket Req
s = Socket Req -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket Req
s ZMQOption
B.reqCorrelate (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_REQ_RELAXED>.
setReqRelaxed :: Bool -> Socket Req -> IO ()
setReqRelaxed :: Bool -> Socket Req -> IO ()
setReqRelaxed Bool
x Socket Req
s = Socket Req -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket Req
s ZMQOption
B.reqRelaxed (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_SNDBUF>.
setSendBuffer :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setSendBuffer :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setSendBuffer = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.sendBuf

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_RECOVERY_IVL>.
setRecoveryInterval :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setRecoveryInterval :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setRecoveryInterval = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.recoveryIVL

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_RCVHWM>.
setReceiveHighWM :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setReceiveHighWM :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setReceiveHighWM = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.receiveHighWM

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_SNDHWM>.
setSendHighWM :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO ()
setSendHighWM :: forall i a.
Integral i =>
Restricted (N0, Int32) i -> Socket a -> IO ()
setSendHighWM = ZMQOption -> Restricted (N0, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.sendHighWM

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_TCP_ACCEPT_FILTER>.
setTcpAcceptFilter :: Maybe SB.ByteString -> Socket a -> IO ()
setTcpAcceptFilter :: forall a. Maybe ByteString -> Socket a -> IO ()
setTcpAcceptFilter Maybe ByteString
Nothing Socket a
sock = String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"setTcpAcceptFilter" Socket a
sock ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
s ->
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"setStrOpt" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
        ZMQCtx -> CInt -> ZMQCtx -> CSize -> IO CInt
c_zmq_setsockopt ZMQCtx
s (ZMQOption -> CInt
optVal ZMQOption
tcpAcceptFilter) ZMQCtx
forall a. Ptr a
nullPtr CSize
0
setTcpAcceptFilter (Just ByteString
dat) Socket a
sock = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
sock ZMQOption
tcpAcceptFilter ByteString
dat

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_TCP_KEEPALIVE>.
setTcpKeepAlive :: Switch -> Socket a -> IO ()
setTcpKeepAlive :: forall a. Switch -> Socket a -> IO ()
setTcpKeepAlive Switch
x Socket a
s = Socket a -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket a
s ZMQOption
B.tcpKeepAlive (Switch -> CInt
forall a. Integral a => Switch -> a
fromSwitch Switch
x :: CInt)

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_TCP_KEEPALIVE_CNT>.
setTcpKeepAliveCount :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setTcpKeepAliveCount :: forall i a.
Integral i =>
Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setTcpKeepAliveCount = ZMQOption -> Restricted (Nneg1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.tcpKeepAliveCount

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_TCP_KEEPALIVE_IDLE>.
setTcpKeepAliveIdle :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setTcpKeepAliveIdle :: forall i a.
Integral i =>
Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setTcpKeepAliveIdle = ZMQOption -> Restricted (Nneg1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.tcpKeepAliveIdle

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_TCP_KEEPALIVE_INTVL>.
setTcpKeepAliveInterval :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setTcpKeepAliveInterval :: forall i a.
Integral i =>
Restricted (Nneg1, Int32) i -> Socket a -> IO ()
setTcpKeepAliveInterval = ZMQOption -> Restricted (Nneg1, Int32) i -> Socket a -> IO ()
forall i r b.
Integral i =>
ZMQOption -> Restricted r i -> Socket b -> IO ()
setInt32OptFromRestricted ZMQOption
B.tcpKeepAliveInterval

-- | <http://api.zeromq.org/4-0:zmq-setsockopt zmq_setsockopt ZMQ_XPUB_VERBOSE>.
setXPubVerbose :: Bool -> Socket XPub -> IO ()
setXPubVerbose :: Bool -> Socket XPub -> IO ()
setXPubVerbose Bool
x Socket XPub
s = Socket XPub -> ZMQOption -> CInt -> IO ()
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO ()
setIntOpt Socket XPub
s ZMQOption
B.xpubVerbose (Bool -> CInt
bool2cint Bool
x)

-- | <http://api.zeromq.org/4-0:zmq-getsockopt zmq_getsockopt ZMQ_ZAP_DOMAIN>.
setZapDomain :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO ()
setZapDomain :: forall a. Restricted (N1, N254) ByteString -> Socket a -> IO ()
setZapDomain Restricted (N1, N254) ByteString
x Socket a
s = Socket a -> ZMQOption -> ByteString -> IO ()
forall a. Socket a -> ZMQOption -> ByteString -> IO ()
setByteStringOpt Socket a
s ZMQOption
B.zapDomain (Restricted (N1, N254) ByteString -> ByteString
forall r v. Restricted r v -> v
rvalue Restricted (N1, N254) ByteString
x)

-- | Bind the socket to the given address
-- (cf. <http://api.zeromq.org/4-0:zmq-bind zmq_bind>).
bind :: Socket a -> String -> IO ()
bind :: forall a. Socket a -> String -> IO ()
bind Socket a
sock String
str = String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"bind" Socket a
sock ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"bind" (IO CInt -> IO ()) -> (ZMQCtx -> IO CInt) -> ZMQCtx -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO CInt) -> IO CInt)
-> (ZMQCtx -> CString -> IO CInt) -> ZMQCtx -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> CString -> IO CInt
c_zmq_bind

-- | Unbind the socket from the given address
-- (cf. <http://api.zeromq.org/4-0:zmq-unbind zmq_unbind>).
unbind :: Socket a -> String -> IO ()
unbind :: forall a. Socket a -> String -> IO ()
unbind Socket a
sock String
str = String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"unbind" Socket a
sock ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"unbind" (IO CInt -> IO ()) -> (ZMQCtx -> IO CInt) -> ZMQCtx -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO CInt) -> IO CInt)
-> (ZMQCtx -> CString -> IO CInt) -> ZMQCtx -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> CString -> IO CInt
c_zmq_unbind

-- | Connect the socket to the given address
-- (cf. <http://api.zeromq.org/4-0:zmq-connect zmq_connect>).
connect :: Socket a -> String -> IO ()
connect :: forall a. Socket a -> String -> IO ()
connect Socket a
sock String
str = String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"connect" Socket a
sock ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"connect" (IO CInt -> IO ()) -> (ZMQCtx -> IO CInt) -> ZMQCtx -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO CInt) -> IO CInt)
-> (ZMQCtx -> CString -> IO CInt) -> ZMQCtx -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> CString -> IO CInt
c_zmq_connect

-- | Disconnect the socket from the given endpoint
-- (cf. <http://api.zeromq.org/4-0:zmq-disconnect zmq_disconnect>).
disconnect :: Socket a -> String -> IO ()
disconnect :: forall a. Socket a -> String -> IO ()
disconnect Socket a
sock String
str = String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"disconnect" Socket a
sock ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"disconnect" (IO CInt -> IO ()) -> (ZMQCtx -> IO CInt) -> ZMQCtx -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO CInt) -> IO CInt)
-> (ZMQCtx -> CString -> IO CInt) -> ZMQCtx -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQCtx -> CString -> IO CInt
c_zmq_disconnect

-- | Send the given 'SB.ByteString' over the socket
-- (cf. <http://api.zeromq.org/4-0:zmq-sendmsg zmq_sendmsg>).
--
-- /Note/: This function always calls @zmq_sendmsg@ in a non-blocking way,
-- i.e. there is no need to provide the @ZMQ_DONTWAIT@ flag as this is used
-- by default. Still 'send' is blocking the thread as long as the message
-- can not be queued on the socket using GHC's 'threadWaitWrite'.
send :: Sender a => Socket a -> [Flag] -> SB.ByteString -> IO ()
send :: forall a. Sender a => Socket a -> [Flag] -> ByteString -> IO ()
send Socket a
sock [Flag]
fls ByteString
val = IO Message -> (Message -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (ByteString -> IO Message
messageOf ByteString
val) Message -> IO ()
messageClose ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
    String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"send" Socket a
sock ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
s ->
        String -> IO () -> IO CInt -> IO ()
retry String
"send" (Socket a -> IO ()
forall a. Socket a -> IO ()
waitWrite Socket a
sock) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
#ifdef mingw32_HOST_OS
            c_zmq_sendmsg s (msgPtr m) (combineFlags fls)
#else
            ZMQCtx -> ZMQMsgPtr -> CInt -> IO CInt
c_zmq_sendmsg ZMQCtx
s (Message -> ZMQMsgPtr
msgPtr Message
m) ([Flag] -> CInt
combineFlags (Flag
DontWait Flag -> [Flag] -> [Flag]
forall a. a -> [a] -> [a]
: [Flag]
fls))
#endif
    Message -> IO ()
messageFree Message
m

-- | Send the given 'LB.ByteString' over the socket
-- (cf. <http://api.zeromq.org/4-0:zmq-sendmsg zmq_sendmsg>).
--
-- This is operationally identical to @send socket (Strict.concat
-- (Lazy.toChunks lbs)) flags@ but may be more efficient.
--
-- /Note/: This function always calls @zmq_sendmsg@ in a non-blocking way,
-- i.e. there is no need to provide the @ZMQ_DONTWAIT@ flag as this is used
-- by default. Still 'send'' is blocking the thread as long as the message
-- can not be queued on the socket using GHC's 'threadWaitWrite'.
send' :: Sender a => Socket a -> [Flag] -> LB.ByteString -> IO ()
send' :: forall a. Sender a => Socket a -> [Flag] -> ByteString -> IO ()
send' Socket a
sock [Flag]
fls ByteString
val = IO Message -> (Message -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError (ByteString -> IO Message
messageOfLazy ByteString
val) Message -> IO ()
messageClose ((Message -> IO ()) -> IO ()) -> (Message -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Message
m -> do
    String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"send'" Socket a
sock ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
s ->
        String -> IO () -> IO CInt -> IO ()
retry String
"send'" (Socket a -> IO ()
forall a. Socket a -> IO ()
waitWrite Socket a
sock) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
#ifdef mingw32_HOST_OS
            c_zmq_sendmsg s (msgPtr m) (combineFlags fls)
#else
            ZMQCtx -> ZMQMsgPtr -> CInt -> IO CInt
c_zmq_sendmsg ZMQCtx
s (Message -> ZMQMsgPtr
msgPtr Message
m) ([Flag] -> CInt
combineFlags (Flag
DontWait Flag -> [Flag] -> [Flag]
forall a. a -> [a] -> [a]
: [Flag]
fls))
#endif
    Message -> IO ()
messageFree Message
m

-- | Send a multi-part message.
-- This function applies the 'SendMore' 'Flag' between all message parts.
-- 0MQ guarantees atomic delivery of a multi-part message
-- (cf. <http://api.zeromq.org/4-0:zmq-sendmsg zmq_sendmsg>).
sendMulti :: Sender a => Socket a -> NonEmpty SB.ByteString -> IO ()
sendMulti :: forall a. Sender a => Socket a -> NonEmpty ByteString -> IO ()
sendMulti Socket a
sock NonEmpty ByteString
msgs = do
    (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Socket a -> [Flag] -> ByteString -> IO ()
forall a. Sender a => Socket a -> [Flag] -> ByteString -> IO ()
send Socket a
sock [Flag
SendMore]) (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
S.init NonEmpty ByteString
msgs)
    Socket a -> [Flag] -> ByteString -> IO ()
forall a. Sender a => Socket a -> [Flag] -> ByteString -> IO ()
send Socket a
sock [] (NonEmpty ByteString -> ByteString
forall a. NonEmpty a -> a
S.last NonEmpty ByteString
msgs)

-- | Receive a 'ByteString' from socket
-- (cf. <http://api.zeromq.org/4-0:zmq-recvmsg zmq_recvmsg>).
--
-- /Note/: This function always calls @zmq_recvmsg@ in a non-blocking way,
-- i.e. there is no need to provide the @ZMQ_DONTWAIT@ flag as this is used
-- by default. Still 'receive' is blocking the thread as long as no data
-- is available using GHC's 'threadWaitRead'.
receive :: Receiver a => Socket a -> IO (SB.ByteString)
receive :: forall a. Receiver a => Socket a -> IO ByteString
receive Socket a
sock = IO Message
-> (Message -> IO ())
-> (Message -> IO ByteString)
-> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Message
messageInit Message -> IO ()
messageClose ((Message -> IO ByteString) -> IO ByteString)
-> (Message -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Message
m ->
  String -> Socket a -> (ZMQCtx -> IO ByteString) -> IO ByteString
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"receive" Socket a
sock ((ZMQCtx -> IO ByteString) -> IO ByteString)
-> (ZMQCtx -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
s -> do
    String -> IO () -> IO CInt -> IO ()
retry String
"receive" (Socket a -> IO ()
forall a. Socket a -> IO ()
waitRead Socket a
sock) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
#ifdef mingw32_HOST_OS
          c_zmq_recvmsg s (msgPtr m) 0
#else
          ZMQCtx -> ZMQMsgPtr -> CInt -> IO CInt
c_zmq_recvmsg ZMQCtx
s (Message -> ZMQMsgPtr
msgPtr Message
m) (ZMQFlag -> CInt
flagVal ZMQFlag
dontWait)
#endif
    CString
data_ptr <- ZMQMsgPtr -> IO CString
forall a. ZMQMsgPtr -> IO (Ptr a)
c_zmq_msg_data (Message -> ZMQMsgPtr
msgPtr Message
m)
    CSize
size     <- ZMQMsgPtr -> IO CSize
c_zmq_msg_size (Message -> ZMQMsgPtr
msgPtr Message
m)
    CStringLen -> IO ByteString
SB.packCStringLen (CString
data_ptr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size)

-- | Receive a multi-part message.
-- This function collects all message parts send via 'sendMulti'.
receiveMulti :: Receiver a => Socket a -> IO [SB.ByteString]
receiveMulti :: forall a. Receiver a => Socket a -> IO [ByteString]
receiveMulti Socket a
sock = [ByteString] -> IO [ByteString]
recvall []
  where
    recvall :: [ByteString] -> IO [ByteString]
recvall [ByteString]
acc = do
        ByteString
msg <- Socket a -> IO ByteString
forall a. Receiver a => Socket a -> IO ByteString
receive Socket a
sock
        Socket a -> IO Bool
forall a. Socket a -> IO Bool
moreToReceive Socket a
sock IO Bool -> (Bool -> IO [ByteString]) -> IO [ByteString]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> Bool -> IO [ByteString]
next (ByteString
msgByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)

    next :: [ByteString] -> Bool -> IO [ByteString]
next [ByteString]
acc Bool
True  = [ByteString] -> IO [ByteString]
recvall [ByteString]
acc
    next [ByteString]
acc Bool
False = [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)

-- | Setup socket monitoring, i.e. a 'Pair' socket which
-- sends monitoring events about the given 'Socket' to the
-- given address.
socketMonitor :: [EventType] -> String -> Socket a -> IO ()
socketMonitor :: forall a. [EventType] -> String -> Socket a -> IO ()
socketMonitor [EventType]
es String
addr Socket a
soc = String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"socketMonitor" Socket a
soc ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
s ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
addr ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
a ->
        String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1_ String
"zmq_socket_monitor" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
            ZMQCtx -> CString -> CInt -> IO CInt
c_zmq_socket_monitor ZMQCtx
s CString
a ([EventType] -> CInt
events2cint [EventType]
es)

-- | Monitor socket events
-- (cf. <http://api.zeromq.org/4-0:zmq-socket-monitor zmq_socket_monitor>).
--
-- This function returns a function which can be invoked to retrieve
-- the next socket event, potentially blocking until the next one becomes
-- available. When applied to 'False', monitoring will terminate, i.e.
-- internal monitoring resources will be disposed. Consequently after
-- 'monitor' has been invoked, the returned function must be applied
-- /once/ to 'False'.
monitor :: [EventType] -> Context -> Socket a -> IO (Bool -> IO (Maybe EventMsg))
monitor :: forall a.
[EventType]
-> Context -> Socket a -> IO (Bool -> IO (Maybe EventMsg))
monitor [EventType]
es Context
ctx Socket a
sock = do
    let addr :: String
addr = String
"inproc://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ZMQCtx -> String
forall a. Show a => a -> String
show (SocketRepr -> ZMQCtx
_socket (SocketRepr -> ZMQCtx)
-> (Socket a -> SocketRepr) -> Socket a -> ZMQCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket a -> SocketRepr
forall a. Socket a -> SocketRepr
_socketRepr (Socket a -> ZMQCtx) -> Socket a -> ZMQCtx
forall a b. (a -> b) -> a -> b
$ Socket a
sock)
    Socket Pair
s <- Context -> Pair -> IO (Socket Pair)
forall a. SocketType a => Context -> a -> IO (Socket a)
socket Context
ctx Pair
Pair
    [EventType] -> String -> Socket a -> IO ()
forall a. [EventType] -> String -> Socket a -> IO ()
socketMonitor [EventType]
es String
addr Socket a
sock
    Socket Pair -> String -> IO ()
forall a. Socket a -> String -> IO ()
connect Socket Pair
s String
addr
    Socket Pair -> Message -> Bool -> IO (Maybe EventMsg)
forall {a}.
Receiver a =>
Socket a -> Message -> Bool -> IO (Maybe EventMsg)
next Socket Pair
s (Message -> Bool -> IO (Maybe EventMsg))
-> IO Message -> IO (Bool -> IO (Maybe EventMsg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Message
messageInit
  where
    next :: Socket a -> Message -> Bool -> IO (Maybe EventMsg)
next Socket a
soc Message
m Bool
False = Message -> IO ()
messageClose Message
m IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Socket a -> IO ()
forall a. Socket a -> IO ()
close Socket a
soc IO () -> IO (Maybe EventMsg) -> IO (Maybe EventMsg)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe EventMsg -> IO (Maybe EventMsg)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EventMsg
forall a. Maybe a
Nothing
    next Socket a
soc Message
m Bool
True  = String
-> Socket a
-> (ZMQCtx -> IO (Maybe EventMsg))
-> IO (Maybe EventMsg)
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"recv" Socket a
soc ((ZMQCtx -> IO (Maybe EventMsg)) -> IO (Maybe EventMsg))
-> (ZMQCtx -> IO (Maybe EventMsg)) -> IO (Maybe EventMsg)
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
s -> do
        String -> IO () -> IO CInt -> IO ()
retry String
"recv" (Socket a -> IO ()
forall a. Socket a -> IO ()
waitRead Socket a
soc) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
#ifdef mingw32_HOST_OS
            c_zmq_recvmsg s (msgPtr m) 0
#else
            ZMQCtx -> ZMQMsgPtr -> CInt -> IO CInt
c_zmq_recvmsg ZMQCtx
s (Message -> ZMQMsgPtr
msgPtr Message
m) (ZMQFlag -> CInt
flagVal ZMQFlag
dontWait)
#endif
        ZMQEvent
evt <- ZMQMsgPtr -> IO ZMQEvent
peekZMQEvent (Message -> ZMQMsgPtr
msgPtr Message
m)
        ByteString
str <- Socket a -> IO ByteString
forall a. Receiver a => Socket a -> IO ByteString
receive Socket a
soc
        Maybe EventMsg -> IO (Maybe EventMsg)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EventMsg -> IO (Maybe EventMsg))
-> (EventMsg -> Maybe EventMsg) -> EventMsg -> IO (Maybe EventMsg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventMsg -> Maybe EventMsg
forall a. a -> Maybe a
Just (EventMsg -> IO (Maybe EventMsg))
-> EventMsg -> IO (Maybe EventMsg)
forall a b. (a -> b) -> a -> b
$ ByteString -> ZMQEvent -> EventMsg
eventMessage ByteString
str ZMQEvent
evt

-- | Polls for events on the given 'Poll' descriptors. Returns a list of
-- events per descriptor which have occured.
-- (cf. <http://api.zeromq.org/4-0:zmq-poll zmq_poll>)
poll :: (SocketLike s, MonadIO m) => Timeout -> [Poll s m] -> m [[Event]]
poll :: forall (s :: * -> *) (m :: * -> *).
(SocketLike s, MonadIO m) =>
Int64 -> [Poll s m] -> m [[Event]]
poll Int64
_    [] = [[Event]] -> m [[Event]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
poll Int64
to [Poll s m]
desc = do
    let len :: Int
len = [Poll s m] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Poll s m]
desc
    let ps :: [ZMQPoll]
ps  = (Poll s m -> ZMQPoll) -> [Poll s m] -> [ZMQPoll]
forall a b. (a -> b) -> [a] -> [b]
map Poll s m -> ZMQPoll
forall (s :: * -> *) (m :: * -> *).
(SocketLike s, MonadIO m) =>
Poll s m -> ZMQPoll
toZMQPoll [Poll s m]
desc
    [ZMQPoll]
ps' <- IO [ZMQPoll] -> m [ZMQPoll]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ZMQPoll] -> m [ZMQPoll]) -> IO [ZMQPoll] -> m [ZMQPoll]
forall a b. (a -> b) -> a -> b
$ [ZMQPoll] -> (Ptr ZMQPoll -> IO [ZMQPoll]) -> IO [ZMQPoll]
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [ZMQPoll]
ps ((Ptr ZMQPoll -> IO [ZMQPoll]) -> IO [ZMQPoll])
-> (Ptr ZMQPoll -> IO [ZMQPoll]) -> IO [ZMQPoll]
forall a b. (a -> b) -> a -> b
$ \Ptr ZMQPoll
ptr -> do
        String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"poll" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
            Ptr ZMQPoll -> CInt -> CLong -> IO CInt
c_zmq_poll Ptr ZMQPoll
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Int64 -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
to)
        Int -> Ptr ZMQPoll -> IO [ZMQPoll]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len Ptr ZMQPoll
ptr
    ((Poll s m, ZMQPoll) -> m [Event])
-> [(Poll s m, ZMQPoll)] -> m [[Event]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Poll s m, ZMQPoll) -> m [Event]
forall (s :: * -> *) (m :: * -> *).
(SocketLike s, MonadIO m) =>
(Poll s m, ZMQPoll) -> m [Event]
fromZMQPoll ([Poll s m] -> [ZMQPoll] -> [(Poll s m, ZMQPoll)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Poll s m]
desc [ZMQPoll]
ps')
  where
    toZMQPoll :: (SocketLike s, MonadIO m) => Poll s m -> ZMQPoll
    toZMQPoll :: forall (s :: * -> *) (m :: * -> *).
(SocketLike s, MonadIO m) =>
Poll s m -> ZMQPoll
toZMQPoll (Sock s t
s [Event]
e Maybe ([Event] -> m ())
_) =
        ZMQCtx -> CInt -> CShort -> CShort -> ZMQPoll
ZMQPoll (SocketRepr -> ZMQCtx
_socket (SocketRepr -> ZMQCtx) -> (s t -> SocketRepr) -> s t -> ZMQCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket t -> SocketRepr
forall a. Socket a -> SocketRepr
_socketRepr (Socket t -> SocketRepr) -> (s t -> Socket t) -> s t -> SocketRepr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s t -> Socket t
forall t. s t -> Socket t
forall (s :: * -> *) t. SocketLike s => s t -> Socket t
toSocket (s t -> ZMQCtx) -> s t -> ZMQCtx
forall a b. (a -> b) -> a -> b
$ s t
s) CInt
0 ([CShort] -> CShort
forall i. (Integral i, Bits i) => [i] -> i
combine ((Event -> CShort) -> [Event] -> [CShort]
forall a b. (a -> b) -> [a] -> [b]
map Event -> CShort
fromEvent [Event]
e)) CShort
0

    toZMQPoll (File (Fd CInt
s) [Event]
e Maybe ([Event] -> m ())
_) =
        ZMQCtx -> CInt -> CShort -> CShort -> ZMQPoll
ZMQPoll ZMQCtx
forall a. Ptr a
nullPtr (CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
s) ([CShort] -> CShort
forall i. (Integral i, Bits i) => [i] -> i
combine ((Event -> CShort) -> [Event] -> [CShort]
forall a b. (a -> b) -> [a] -> [b]
map Event -> CShort
fromEvent [Event]
e)) CShort
0

    fromZMQPoll :: (SocketLike s, MonadIO m) => (Poll s m, ZMQPoll) -> m [Event]
    fromZMQPoll :: forall (s :: * -> *) (m :: * -> *).
(SocketLike s, MonadIO m) =>
(Poll s m, ZMQPoll) -> m [Event]
fromZMQPoll (Poll s m
p, ZMQPoll
zp) = do
        let e :: [Event]
e = Word32 -> [Event]
toEvents (Word32 -> [Event]) -> (ZMQPoll -> Word32) -> ZMQPoll -> [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShort -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Word32) -> (ZMQPoll -> CShort) -> ZMQPoll -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQPoll -> CShort
pRevents (ZMQPoll -> [Event]) -> ZMQPoll -> [Event]
forall a b. (a -> b) -> a -> b
$ ZMQPoll
zp
        let ([Event]
e', Maybe ([Event] -> m ())
f) = case Poll s m
p of
                        (Sock s t
_ [Event]
x Maybe ([Event] -> m ())
g) -> ([Event]
x, Maybe ([Event] -> m ())
g)
                        (File Fd
_ [Event]
x Maybe ([Event] -> m ())
g) -> ([Event]
x, Maybe ([Event] -> m ())
g)
        Maybe ([Event] -> m ())
-> (([Event] -> m ()) -> m ()) -> m (Maybe ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe ([Event] -> m ())
f (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Event] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null ([Event]
e [Event] -> [Event] -> [Event]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Event]
e')) (m () -> m ())
-> (([Event] -> m ()) -> m ()) -> ([Event] -> m ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Event] -> m ()) -> [Event] -> m ()
forall a b. (a -> b) -> a -> b
$ [Event]
e)) m (Maybe ()) -> m [Event] -> m [Event]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Event] -> m [Event]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
e

    fromEvent :: Event -> CShort
    fromEvent :: Event -> CShort
fromEvent Event
In   = CShort -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> CShort)
-> (ZMQPollEvent -> CShort) -> ZMQPollEvent -> CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQPollEvent -> CShort
pollVal (ZMQPollEvent -> CShort) -> ZMQPollEvent -> CShort
forall a b. (a -> b) -> a -> b
$ ZMQPollEvent
pollIn
    fromEvent Event
Out  = CShort -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> CShort)
-> (ZMQPollEvent -> CShort) -> ZMQPollEvent -> CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQPollEvent -> CShort
pollVal (ZMQPollEvent -> CShort) -> ZMQPollEvent -> CShort
forall a b. (a -> b) -> a -> b
$ ZMQPollEvent
pollOut
    fromEvent Event
Err  = CShort -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> CShort)
-> (ZMQPollEvent -> CShort) -> ZMQPollEvent -> CShort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQPollEvent -> CShort
pollVal (ZMQPollEvent -> CShort) -> ZMQPollEvent -> CShort
forall a b. (a -> b) -> a -> b
$ ZMQPollEvent
pollerr

-- Convert bit-masked word into Event list.
toEvents :: Word32 -> [Event]
toEvents :: Word32 -> [Event]
toEvents Word32
e = ([Event] -> (Word32 -> [Event] -> [Event]) -> [Event])
-> [Event] -> [Word32 -> [Event] -> [Event]] -> [Event]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[Event]
es Word32 -> [Event] -> [Event]
f -> Word32 -> [Event] -> [Event]
f Word32
e [Event]
es) [] [Word32 -> [Event] -> [Event]]
tests
  where
      tests :: [Word32 -> [Event] -> [Event]]
tests =
        [ \Word32
i [Event]
xs -> if Word32
i Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (CShort -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Word32)
-> (ZMQPollEvent -> CShort) -> ZMQPollEvent -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQPollEvent -> CShort
pollVal (ZMQPollEvent -> Word32) -> ZMQPollEvent -> Word32
forall a b. (a -> b) -> a -> b
$ ZMQPollEvent
pollIn)  Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then Event
InEvent -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:[Event]
xs else [Event]
xs
        , \Word32
i [Event]
xs -> if Word32
i Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (CShort -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Word32)
-> (ZMQPollEvent -> CShort) -> ZMQPollEvent -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQPollEvent -> CShort
pollVal (ZMQPollEvent -> Word32) -> ZMQPollEvent -> Word32
forall a b. (a -> b) -> a -> b
$ ZMQPollEvent
pollOut) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then Event
OutEvent -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:[Event]
xs else [Event]
xs
        , \Word32
i [Event]
xs -> if Word32
i Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (CShort -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort -> Word32)
-> (ZMQPollEvent -> CShort) -> ZMQPollEvent -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZMQPollEvent -> CShort
pollVal (ZMQPollEvent -> Word32) -> ZMQPollEvent -> Word32
forall a b. (a -> b) -> a -> b
$ ZMQPollEvent
pollerr) Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 then Event
ErrEvent -> [Event] -> [Event]
forall a. a -> [a] -> [a]
:[Event]
xs else [Event]
xs
        ]

retry :: String -> IO () -> IO CInt -> IO ()
retry :: String -> IO () -> IO CInt -> IO ()
retry String
msg IO ()
wait IO CInt
act = String -> IO CInt -> IO () -> IO ()
forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO ()
throwIfMinus1RetryMayBlock_ String
msg IO CInt
act IO ()
wait

wait' :: ZMQPollEvent -> Socket a -> IO ()
#ifdef mingw32_HOST_OS
wait' _ _ = return ()
#else
wait' :: forall a. ZMQPollEvent -> Socket a -> IO ()
wait' ZMQPollEvent
p Socket a
s = do
    Int
e <- ZMQOption -> Socket a -> IO Int
forall a. ZMQOption -> Socket a -> IO Int
getInt32Option ZMQOption
B.events Socket a
s
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Bool
testev Int
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        CInt
fd <- Socket a -> ZMQOption -> CInt -> IO CInt
forall b a.
(Storable b, Integral b) =>
Socket a -> ZMQOption -> b -> IO b
getIntOpt Socket a
s ZMQOption
B.filedesc CInt
0
        Fd -> IO ()
threadWaitRead (CInt -> Fd
Fd CInt
fd)
        ZMQPollEvent -> Socket a -> IO ()
forall a. ZMQPollEvent -> Socket a -> IO ()
wait' ZMQPollEvent
p Socket a
s
  where
    testev :: Int -> Bool
testev Int
e = Int
e Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. CShort -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ZMQPollEvent -> CShort
pollVal ZMQPollEvent
p) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
#endif

-- | Wait until data is available for reading from the given Socket.
-- After this function returns, a call to 'receive' will essentially be
-- non-blocking.
waitRead :: Socket a -> IO ()
waitRead :: forall a. Socket a -> IO ()
waitRead = ZMQPollEvent -> Socket a -> IO ()
forall a. ZMQPollEvent -> Socket a -> IO ()
wait' ZMQPollEvent
pollIn

-- | Wait until data can be written to the given Socket.
-- After this function returns, a call to 'send' will essentially be
-- non-blocking.
waitWrite :: Socket a -> IO ()
waitWrite :: forall a. Socket a -> IO ()
waitWrite = ZMQPollEvent -> Socket a -> IO ()
forall a. ZMQPollEvent -> Socket a -> IO ()
wait' ZMQPollEvent
pollOut

-- | Starts built-in 0MQ proxy
-- (cf. <http://api.zeromq.org/4-0:zmq-proxy zmq_proxy>)
--
-- Proxy connects front to back socket
--
-- Before calling proxy all sockets should be bound
--
-- If the capture socket is not Nothing, the proxy  shall send all
-- messages, received on both frontend and backend, to the capture socket.
proxy :: Socket a -> Socket b -> Maybe (Socket c) -> IO ()
proxy :: forall a b c. Socket a -> Socket b -> Maybe (Socket c) -> IO ()
proxy Socket a
front Socket b
back Maybe (Socket c)
capture =
    String -> Socket a -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"proxy-front" Socket a
front ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
f ->
    String -> Socket b -> (ZMQCtx -> IO ()) -> IO ()
forall a b. String -> Socket a -> (ZMQCtx -> IO b) -> IO b
onSocket String
"proxy-back"  Socket b
back  ((ZMQCtx -> IO ()) -> IO ()) -> (ZMQCtx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZMQCtx
b ->
        String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1Retry_ String
"c_zmq_proxy" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ ZMQCtx -> ZMQCtx -> ZMQCtx -> IO CInt
c_zmq_proxy ZMQCtx
f ZMQCtx
b ZMQCtx
c
  where
    c :: ZMQCtx
c = ZMQCtx -> (Socket c -> ZMQCtx) -> Maybe (Socket c) -> ZMQCtx
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ZMQCtx
forall a. Ptr a
nullPtr (SocketRepr -> ZMQCtx
_socket (SocketRepr -> ZMQCtx)
-> (Socket c -> SocketRepr) -> Socket c -> ZMQCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket c -> SocketRepr
forall a. Socket a -> SocketRepr
_socketRepr) Maybe (Socket c)
capture

-- | Generate a new curve key pair.
-- (cf. <http://api.zeromq.org/4-0:zmq-curve-keypair zmq_curve_keypair>)
curveKeyPair :: MonadIO m => m (Restricted Div5 SB.ByteString, Restricted Div5 SB.ByteString)
curveKeyPair :: forall (m :: * -> *).
MonadIO m =>
m (Restricted Div5 ByteString, Restricted Div5 ByteString)
curveKeyPair = IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
-> m (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
 -> m (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
-> m (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a b. (a -> b) -> a -> b
$
    Int
-> (CString
    -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
41 ((CString
  -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
 -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> (CString
    -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
cstr1 ->
    Int
-> (CString
    -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
41 ((CString
  -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
 -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> (CString
    -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
cstr2 -> do
        String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwIfMinus1_ String
"c_zmq_curve_keypair" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CString -> CString -> IO CInt
c_zmq_curve_keypair CString
cstr1 CString
cstr2
        Maybe (Restricted Div5 ByteString)
public  <- ByteString -> Maybe (Restricted Div5 ByteString)
forall r v. Restriction r v => v -> Maybe (Restricted r v)
toRestricted (ByteString -> Maybe (Restricted Div5 ByteString))
-> IO ByteString -> IO (Maybe (Restricted Div5 ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
SB.packCString CString
cstr1
        Maybe (Restricted Div5 ByteString)
private <- ByteString -> Maybe (Restricted Div5 ByteString)
forall r v. Restriction r v => v -> Maybe (Restricted r v)
toRestricted (ByteString -> Maybe (Restricted Div5 ByteString))
-> IO ByteString -> IO (Maybe (Restricted Div5 ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
SB.packCString CString
cstr2
        IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
-> ((Restricted Div5 ByteString, Restricted Div5 ByteString)
    -> IO (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> Maybe (Restricted Div5 ByteString, Restricted Div5 ByteString)
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errmsg) (Restricted Div5 ByteString, Restricted Div5 ByteString)
-> IO (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((,) (Restricted Div5 ByteString
 -> Restricted Div5 ByteString
 -> (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> Maybe (Restricted Div5 ByteString)
-> Maybe
     (Restricted Div5 ByteString
      -> (Restricted Div5 ByteString, Restricted Div5 ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Restricted Div5 ByteString)
public Maybe
  (Restricted Div5 ByteString
   -> (Restricted Div5 ByteString, Restricted Div5 ByteString))
-> Maybe (Restricted Div5 ByteString)
-> Maybe (Restricted Div5 ByteString, Restricted Div5 ByteString)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Restricted Div5 ByteString)
private)
      where
        errmsg :: String
errmsg = String
"curveKeyPair: invalid key-lengths produced"