{-# LINE 1 "src/Nanomsg.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}
-- |
-- Module:          Nanomsg
-- Copyright:       (c) 2013 Ivar Nymoen
-- License:         MIT
-- Stability:       experimental
--
-- This is a Haskell binding for the nanomsg library: <http://nanomsg.org/>.
--
-- There's support for (evented) blocking send and recv, a non-blocking receive,
-- and for all the socket types and the functions you need to wire
-- them up and tear them down again.
--
-- Most socket options are available through accessor and mutator
-- functions. Sockets are typed, transports are not.
--
-- The documentation is adapted or quoted verbatim from the nanomsg manual,
-- please refer to nanomsg.org for authoritative info.
-- There's a simple code example in <https://github.com/ivarnymoen/nanomsg-haskell#usage README.md>.
module Nanomsg
        (
        -- * Types
        -- ** Socket types
          Pair(..)
        , Req(..)
        , Rep(..)
        , Pub(..)
        , Sub(..)
        , Surveyor(..)
        , Respondent(..)
        , Push(..)
        , Pull(..)
        , Bus(..)
        -- ** Other
        , Socket
        , Endpoint
        , NNException
        , SocketType
        , Sender
        , Receiver
        -- * Operations
        -- ** General operations
        , socket
        , withSocket
        , bind
        , connect
        , send
        , recv
        , recv'
        , subscribe
        , unsubscribe
        , shutdown
        , close
        , term
        -- ** Socket option settings
        , linger
        , setLinger
        , sndBuf
        , setSndBuf
        , rcvBuf
        , setRcvBuf
        , rcvMaxSize
        , setRcvMaxSize
        , reconnectInterval
        , setReconnectInterval
        , reconnectIntervalMax
        , setReconnectIntervalMax
        , sndPrio
        , setSndPrio
        , ipv4Only
        , setIpv4Only
        , requestResendInterval
        , setRequestResendInterval
        , surveyorDeadline
        , setSurveyorDeadline
        , tcpNoDelay
        , setTcpNoDelay
    ) where










import Data.ByteString (ByteString)
-- import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Unsafe as U
import Foreign (peek, poke, alloca)
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.Storable (sizeOf)
import Control.Applicative ( (<$>) )
import Control.Exception.Base (bracket)
import Control.Exception (Exception, throwIO)
import Data.Typeable (Typeable)
import Control.Monad (void)
import Text.Printf (printf)
import Control.Concurrent (threadWaitRead, threadWaitWrite)
import System.Posix.Types (Fd(..))


-- * Data and typedefs

-- | Socket for communication with exactly one peer. Each
-- party can send messages at any time. If the peer is not
-- available or the send buffer is full, subsequent calls
-- will block until it’s possible to send the message.
data Pair = Pair

-- | Request socket. Pairs with 'Rep' sockets.
--
-- The socket will resend requests automatically
-- if there's no reply within a given time. The default timeout
-- is 1 minute.
--
-- See also 'Rep', 'setRequestResendInterval'.
data Req = Req

-- | Reply socket.
--
-- See also 'Req'.
data Rep = Rep

-- | Publish socket. Pairs with subscribe sockets.
--
-- See also 'Sub'.
data Pub = Pub

-- | Subscribe socket.
--
-- Only messages that the socket is subscribed to are received. When the socket
-- is created there are no subscriptions and thus no messages will be received.
--
-- See also 'Pub', 'subscribe' and 'unsubscribe'.
data Sub = Sub

-- | Surveyor and respondent are used to broadcast a survey to multiple
-- locations and gather the responses.
--
-- This socket is used to send a survey. The survey is delivered to all
-- onnected respondents. Once the query is sent, the socket can be used
-- to receive the responses.
--
-- When the survey deadline expires, receive will throw an NNException.
--
-- See also 'Respondent', 'setSurveyorDeadline'.
data Surveyor = Surveyor

-- | Used to respond to a survey. Survey is received using receive,
-- response is sent using send. This socket can be connected to
-- at most one peer.
--
-- See also 'Surveyor'.
data Respondent = Respondent

-- | Push and Pull sockets fair queue messages from one processing step, load
-- balancing them among instances of the next processing step.
--
-- See also 'Pull'.
data Push = Push

-- | Pull socket.
--
-- See also 'Push'.
data Pull = Pull

-- | Broadcasts messages from any node to all other nodes in the topology.
-- The socket should never receives messages that it sent itself.
data Bus = Bus

-- | Endpoint identifier. Created by 'connect' or 'bind'.
--
-- Close connections using 'shutdown'.
data Endpoint = Endpoint CInt
    deriving (Endpoint -> Endpoint -> Bool
(Endpoint -> Endpoint -> Bool)
-> (Endpoint -> Endpoint -> Bool) -> Eq Endpoint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
/= :: Endpoint -> Endpoint -> Bool
Eq, Int -> Endpoint -> String -> String
[Endpoint] -> String -> String
Endpoint -> String
(Int -> Endpoint -> String -> String)
-> (Endpoint -> String)
-> ([Endpoint] -> String -> String)
-> Show Endpoint
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Endpoint -> String -> String
showsPrec :: Int -> Endpoint -> String -> String
$cshow :: Endpoint -> String
show :: Endpoint -> String
$cshowList :: [Endpoint] -> String -> String
showList :: [Endpoint] -> String -> String
Show)

-- | Sockets are created by 'socket' and connections are established with 'connect' or 'bind'.
--
-- Free sockets using 'close'.
data Socket a = Socket a CInt
    deriving (Socket a -> Socket a -> Bool
(Socket a -> Socket a -> Bool)
-> (Socket a -> Socket a -> Bool) -> Eq (Socket a)
forall a. Eq a => Socket a -> Socket a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Socket a -> Socket a -> Bool
== :: Socket a -> Socket a -> Bool
$c/= :: forall a. Eq a => Socket a -> Socket a -> Bool
/= :: Socket a -> Socket a -> Bool
Eq, Int -> Socket a -> String -> String
[Socket a] -> String -> String
Socket a -> String
(Int -> Socket a -> String -> String)
-> (Socket a -> String)
-> ([Socket a] -> String -> String)
-> Show (Socket a)
forall a. Show a => Int -> Socket a -> String -> String
forall a. Show a => [Socket a] -> String -> String
forall a. Show a => Socket a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Socket a -> String -> String
showsPrec :: Int -> Socket a -> String -> String
$cshow :: forall a. Show a => Socket a -> String
show :: Socket a -> String
$cshowList :: forall a. Show a => [Socket a] -> String -> String
showList :: [Socket a] -> String -> String
Show)

-- | Typeclass for all sockets
class SocketType a where
    socketType :: a -> CInt -- ^ Returns the C enum value for each type. E.g. Pair => #const NN_PAIR

instance SocketType Pair where
    socketType :: Pair -> CInt
socketType Pair
Pair = CInt
16
{-# LINE 195 "src/Nanomsg.hsc" #-}

instance SocketType Req where
    socketType :: Req -> CInt
socketType Req
Req = CInt
48
{-# LINE 198 "src/Nanomsg.hsc" #-}

instance SocketType Rep where
    socketType :: Rep -> CInt
socketType Rep
Rep = CInt
49
{-# LINE 201 "src/Nanomsg.hsc" #-}

instance SocketType Pub where
    socketType :: Pub -> CInt
socketType Pub
Pub = CInt
32
{-# LINE 204 "src/Nanomsg.hsc" #-}

instance SocketType Sub where
    socketType :: Sub -> CInt
socketType Sub
Sub = CInt
33
{-# LINE 207 "src/Nanomsg.hsc" #-}

instance SocketType Surveyor where
    socketType :: Surveyor -> CInt
socketType Surveyor
Surveyor = CInt
98
{-# LINE 210 "src/Nanomsg.hsc" #-}

instance SocketType Respondent where
    socketType :: Respondent -> CInt
socketType Respondent
Respondent = CInt
99
{-# LINE 213 "src/Nanomsg.hsc" #-}

instance SocketType Push where
    socketType :: Push -> CInt
socketType Push
Push = CInt
80
{-# LINE 216 "src/Nanomsg.hsc" #-}

instance SocketType Pull where
    socketType :: Pull -> CInt
socketType Pull
Pull = CInt
81
{-# LINE 219 "src/Nanomsg.hsc" #-}

instance SocketType Bus where
    socketType :: Bus -> CInt
socketType Bus
Bus = CInt
112
{-# LINE 222 "src/Nanomsg.hsc" #-}


-- | Typeclass restricting which sockets can use the send function.
class (SocketType a) => Sender a
instance Sender Pair
instance Sender Req
instance Sender Rep
instance Sender Pub
instance Sender Surveyor
instance Sender Respondent
instance Sender Push
instance Sender Bus

-- | Typeclass for sockets that implement recv
class (SocketType a) => Receiver a
instance Receiver Pair
instance Receiver Req
instance Receiver Rep
instance Receiver Sub
instance Receiver Surveyor
instance Receiver Respondent
instance Receiver Pull
instance Receiver Bus


-- * Error handling
--
-- Reimplementing some of Foreign.C.Error here, to substitute nanomsg's errno
-- and strerror functions for the posix ones.

-- | Pretty much any error condition throws this exception.
data NNException = NNException String
        deriving (NNException -> NNException -> Bool
(NNException -> NNException -> Bool)
-> (NNException -> NNException -> Bool) -> Eq NNException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NNException -> NNException -> Bool
== :: NNException -> NNException -> Bool
$c/= :: NNException -> NNException -> Bool
/= :: NNException -> NNException -> Bool
Eq, Int -> NNException -> String -> String
[NNException] -> String -> String
NNException -> String
(Int -> NNException -> String -> String)
-> (NNException -> String)
-> ([NNException] -> String -> String)
-> Show NNException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> NNException -> String -> String
showsPrec :: Int -> NNException -> String -> String
$cshow :: NNException -> String
show :: NNException -> String
$cshowList :: [NNException] -> String -> String
showList :: [NNException] -> String -> String
Show, Typeable)

instance Exception NNException

mkErrorString :: String -> IO String
mkErrorString :: String -> IO String
mkErrorString String
loc = do
    CInt
errNo <- IO CInt
c_nn_errno
    CString
errCString <- CInt -> IO CString
c_nn_strerror CInt
errNo
    String
errString <- CString -> IO String
peekCString CString
errCString
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"nanomsg-haskell error at %s. Errno %d: %s" String
loc (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
errNo :: Int) String
errString

throwErrno :: String -> IO a
throwErrno :: forall a. String -> IO a
throwErrno String
loc = do
    String
s <- String -> IO String
mkErrorString String
loc
    NNException -> IO a
forall e a. Exception e => e -> IO a
throwIO (NNException -> IO a) -> NNException -> IO a
forall a b. (a -> b) -> a -> b
$ String -> NNException
NNException String
s

throwErrnoIf :: (a -> Bool) -> String -> IO a -> IO a
throwErrnoIf :: forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIf a -> Bool
p String
loc IO a
action = do
    a
res <- IO a
action
    if a -> Bool
p a
res then String -> IO a
forall a. String -> IO a
throwErrno String
loc else a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

throwErrnoIf_ :: (a -> Bool) -> String -> IO a -> IO ()
throwErrnoIf_ :: forall a. (a -> Bool) -> String -> IO a -> IO ()
throwErrnoIf_ a -> Bool
p String
loc IO a
action = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> String -> IO a -> IO a
forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIf a -> Bool
p String
loc IO a
action

throwErrnoIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 :: forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 = (a -> Bool) -> String -> IO a -> IO a
forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIf (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1)

throwErrnoIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ :: forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ = (a -> Bool) -> String -> IO a -> IO ()
forall a. (a -> Bool) -> String -> IO a -> IO ()
throwErrnoIf_ (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1)

throwErrnoIfRetry :: (a -> Bool) -> String -> IO a -> IO a
throwErrnoIfRetry :: forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIfRetry a -> Bool
p String
loc IO a
f = do
    a
res <- IO a
f
    if a -> Bool
p a
res
        then do
            CInt
err <- IO CInt
c_nn_errno
            if CInt
err CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt
11) Bool -> Bool -> Bool
|| CInt
err CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt
4)
{-# LINE 291 "src/Nanomsg.hsc" #-}
                then (a -> Bool) -> String -> IO a -> IO a
forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIfRetry a -> Bool
p String
loc IO a
f
                else String -> IO a
forall a. String -> IO a
throwErrno String
loc
        else a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

throwErrnoIfRetry_ :: (a -> Bool) -> String -> IO a -> IO ()
throwErrnoIfRetry_ :: forall a. (a -> Bool) -> String -> IO a -> IO ()
throwErrnoIfRetry_ a -> Bool
p String
loc IO a
f = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> String -> IO a -> IO a
forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIfRetry a -> Bool
p String
loc IO a
f

{-
throwErrnoIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry = throwErrnoIfRetry (== -1)
-}

throwErrnoIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ :: forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ = (a -> Bool) -> String -> IO a -> IO ()
forall a. (a -> Bool) -> String -> IO a -> IO ()
throwErrnoIfRetry_ (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1)

throwErrnoIfRetryMayBlock :: (a -> Bool) -> String -> IO a -> IO b -> IO a
throwErrnoIfRetryMayBlock :: forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
throwErrnoIfRetryMayBlock a -> Bool
p String
loc IO a
f IO b
on_block = do
    a
res <- IO a
f
    if a -> Bool
p a
res
        then do
            CInt
err <- IO CInt
c_nn_errno
            if CInt
err CInt -> [CInt] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ (CInt
11), (CInt
4), (CInt
11) ]
{-# LINE 313 "src/Nanomsg.hsc" #-}
                then do
                    IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO b
on_block
                    (a -> Bool) -> String -> IO a -> IO b -> IO a
forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
throwErrnoIfRetryMayBlock a -> Bool
p String
loc IO a
f IO b
on_block
                else String -> IO a
forall a. String -> IO a
throwErrno String
loc
        else a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
throwErrnoIfRetryMayBlock_ :: forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO ()
throwErrnoIfRetryMayBlock_ a -> Bool
p String
loc IO a
f IO b
on_block = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> String -> IO a -> IO b -> IO a
forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
throwErrnoIfRetryMayBlock a -> Bool
p String
loc IO a
f IO b
on_block

throwErrnoIfMinus1RetryMayBlock :: (Eq a, Num a) => String -> IO a -> IO b -> IO a
throwErrnoIfMinus1RetryMayBlock :: forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO a
throwErrnoIfMinus1RetryMayBlock = (a -> Bool) -> String -> IO a -> IO b -> IO a
forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO a
throwErrnoIfRetryMayBlock (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1)

throwErrnoIfMinus1RetryMayBlock_ :: (Eq a, Num a) => String -> IO a -> IO b -> IO ()
throwErrnoIfMinus1RetryMayBlock_ :: forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO ()
throwErrnoIfMinus1RetryMayBlock_ = (a -> Bool) -> String -> IO a -> IO b -> IO ()
forall a b. (a -> Bool) -> String -> IO a -> IO b -> IO ()
throwErrnoIfRetryMayBlock_ (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== -a
1)


-- * FFI functions

-- NN_EXPORT int nn_socket (int domain, int protocol);
foreign import ccall safe "nn.h nn_socket"
    c_nn_socket :: CInt -> CInt -> IO CInt

-- NN_EXPORT int nn_bind (int s, const char *addr);
foreign import ccall safe "nn.h nn_bind"
    c_nn_bind :: CInt -> CString -> IO CInt

-- NN_EXPORT int nn_connect (int s, const char *addr);
foreign import ccall safe "nn.h nn_connect"
    c_nn_connect :: CInt -> CString -> IO CInt

-- NN_EXPORT int nn_shutdown (int s, int how);
foreign import ccall safe "nn.h nn_shutdown"
    c_nn_shutdown :: CInt -> CInt -> IO CInt

-- NN_EXPORT int nn_send (int s, const void *buf, size_t len, int flags);
foreign import ccall safe "nn.h nn_send"
    c_nn_send :: CInt -> CString -> CSize -> CInt -> IO CInt

-- NN_EXPORT int nn_recv (int s, void *buf, size_t len, int flags);
foreign import ccall safe "nn.h nn_recv"
    c_nn_recv :: CInt -> Ptr CString -> CSize -> CInt -> IO CInt

-- NN_EXPORT int nn_freemsg (void *msg);
foreign import ccall safe "nn.h nn_freemsg"
    c_nn_freemsg :: Ptr CChar -> IO CInt

-- NN_EXPORT int nn_close (int s);
foreign import ccall safe "nn.h nn_close"
    c_nn_close :: CInt -> IO CInt

-- NN_EXPORT void nn_term (void);
foreign import ccall safe "nn.h nn_term"
    c_nn_term :: IO ()

-- NN_EXPORT int nn_setsockopt (int s, int level, int option, const void *optval, size_t optvallen);
foreign import ccall safe "nn.h nn_setsockopt"
    c_nn_setsockopt :: CInt -> CInt -> CInt -> Ptr a -> CSize -> IO CInt

-- NN_EXPORT int nn_getsockopt (int s, int level, int option, void *optval, size_t *optvallen);
foreign import ccall safe "nn.h nn_getsockopt"
    c_nn_getsockopt :: CInt -> CInt -> CInt -> Ptr a -> Ptr CSize -> IO CInt

-- /*  Resolves system errors and native errors to human-readable string.        */
-- NN_EXPORT const char *nn_strerror (int errnum);
foreign import ccall safe "nn.h nn_strerror"
    c_nn_strerror :: CInt -> IO CString

-- /*  This function retrieves the errno as it is known to the library.          */
-- /*  The goal of this function is to make the code 100% portable, including    */
-- /*  where the library is compiled with certain CRT library (on Windows) and   */
-- /*  linked to an application that uses different CRT library.                 */
-- NN_EXPORT int nn_errno (void);
foreign import ccall safe "nn.h nn_errno"
    c_nn_errno :: IO CInt

{-

Unbound FFI functions:

NN_EXPORT int nn_sendmsg (int s, const struct nn_msghdr *msghdr, int flags);
NN_EXPORT int nn_recvmsg (int s, struct nn_msghdr *msghdr, int flags);

NN_EXPORT void *nn_allocmsg (size_t size, int type);
-}

-- * Operations

-- | Creates a socket. Connections are formed using 'bind' or 'connect'.
--
-- See also: 'close'.
socket :: (SocketType a) => a -> IO (Socket a)
socket :: forall a. SocketType a => a -> IO (Socket a)
socket a
t = do
    CInt
sid <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"socket" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> IO CInt
c_nn_socket (CInt
1) (a -> CInt
forall a. SocketType a => a -> CInt
socketType a
t)
{-# LINE 406 "src/Nanomsg.hsc" #-}
    return $ Socket t sid

-- | Creates a socket and runs your action with it.
--
-- E.g. collecting 10 messages:
--
-- > withSocket Sub $ \sub -> do
-- >     _ <- connect sub "tcp://localhost:5560"
-- >     subscribe sub (C.pack "")
-- >     replicateM 10 (recv sub)
--
-- Ensures the socket is closed when your action is done.
withSocket :: (SocketType a) => a -> (Socket a -> IO b) -> IO b
withSocket :: forall a b. SocketType a => a -> (Socket a -> IO b) -> IO b
withSocket 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 (a -> IO (Socket a)
forall a. SocketType a => a -> IO (Socket a)
socket a
t) Socket a -> IO ()
forall a. Socket a -> IO ()
close

-- | Binds the socket to a local interface.
--
-- See the nanomsg documentation for specifics on transports.
-- Note that host names do not work for tcp. Some examples are:
--
-- > bind sock "tcp://*:5560"
-- > bind sock "tcp://eth0:5560"
-- > bind sock "tcp://127.0.0.1:5560"
-- > bind sock "inproc://test"
-- > bind sock "ipc:///tmp/test.ipc"
--
-- This function returns an 'Endpoint', which can be supplied
-- to 'shutdown' to remove a connection.
--
-- See also: 'connect', 'shutdown'.
bind :: Socket a -> String -> IO Endpoint
bind :: forall a. Socket a -> String -> IO Endpoint
bind (Socket a
_ CInt
sid) String
addr =
    String -> (CString -> IO Endpoint) -> IO Endpoint
forall a. String -> (CString -> IO a) -> IO a
withCString String
addr ((CString -> IO Endpoint) -> IO Endpoint)
-> (CString -> IO Endpoint) -> IO Endpoint
forall a b. (a -> b) -> a -> b
$ \CString
adr -> do
        CInt
epid <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"bind" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ CInt -> CString -> IO CInt
c_nn_bind CInt
sid CString
adr
        Endpoint -> IO Endpoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Endpoint -> IO Endpoint) -> Endpoint -> IO Endpoint
forall a b. (a -> b) -> a -> b
$ CInt -> Endpoint
Endpoint CInt
epid

-- | Connects the socket to an endpoint.
--
-- e.g. :
--
-- > connect sock "tcp://localhost:5560"
-- > connect sock "inproc://test"
--
-- See also: 'bind', 'shutdown'.
connect :: Socket a -> String -> IO Endpoint
connect :: forall a. Socket a -> String -> IO Endpoint
connect (Socket a
_ CInt
sid) String
addr =
    String -> (CString -> IO Endpoint) -> IO Endpoint
forall a. String -> (CString -> IO a) -> IO a
withCString String
addr ((CString -> IO Endpoint) -> IO Endpoint)
-> (CString -> IO Endpoint) -> IO Endpoint
forall a b. (a -> b) -> a -> b
$ \CString
adr -> do
        CInt
epid <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"connect" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ CInt -> CString -> IO CInt
c_nn_connect CInt
sid CString
adr
        Endpoint -> IO Endpoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Endpoint -> IO Endpoint) -> Endpoint -> IO Endpoint
forall a b. (a -> b) -> a -> b
$ CInt -> Endpoint
Endpoint CInt
epid

-- | Removes an endpoint from a socket.
--
-- See also: 'bind', 'connect'.
shutdown :: Socket a -> Endpoint -> IO ()
shutdown :: forall a. Socket a -> Endpoint -> IO ()
shutdown (Socket a
_ CInt
sid) (Endpoint CInt
eid) =
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"shutdown" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> IO CInt
c_nn_shutdown CInt
sid CInt
eid

-- | Blocking function for sending a message
--
-- See also: 'recv', 'recv''.
send :: Sender a => Socket a -> ByteString -> IO ()
send :: forall a. Sender a => Socket a -> ByteString -> IO ()
send (Socket a
t CInt
sid) ByteString
string =
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
U.unsafeUseAsCStringLen ByteString
string ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
ptr, Int
len) ->
        String -> IO CInt -> IO () -> IO ()
forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO ()
throwErrnoIfMinus1RetryMayBlock_
            String
"send"
            (CInt -> CString -> CSize -> CInt -> IO CInt
c_nn_send CInt
sid CString
ptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (CInt
1))
{-# LINE 472 "src/Nanomsg.hsc" #-}
            (Socket a -> CInt -> IO Fd
forall a. Socket a -> CInt -> IO Fd
getOptionFd (a -> CInt -> Socket a
forall a. a -> CInt -> Socket a
Socket a
t CInt
sid) (CInt
10) IO Fd -> (Fd -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO ()
threadWaitRead)
{-# LINE 473 "src/Nanomsg.hsc" #-}

-- | Blocking receive.
recv :: Receiver a => Socket a -> IO ByteString
recv :: forall a. Receiver a => Socket a -> IO ByteString
recv (Socket a
t CInt
sid) =
    (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO ByteString) -> IO ByteString)
-> (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CString
ptr -> do
        CInt
len <- String -> IO CInt -> IO () -> IO CInt
forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO a
throwErrnoIfMinus1RetryMayBlock
                String
"recv"
                (CInt -> Ptr CString -> CSize -> CInt -> IO CInt
c_nn_recv CInt
sid Ptr CString
ptr (CSize
18446744073709551615) (CInt
1))
{-# LINE 481 "src/Nanomsg.hsc" #-}
                (Socket a -> CInt -> IO Fd
forall a. Socket a -> CInt -> IO Fd
getOptionFd (a -> CInt -> Socket a
forall a. a -> CInt -> Socket a
Socket a
t CInt
sid) (CInt
11) IO Fd -> (Fd -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO ()
threadWaitRead)
{-# LINE 482 "src/Nanomsg.hsc" #-}
        CString
buf <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
ptr
        ByteString
str <- CStringLen -> IO ByteString
C.packCStringLen (CString
buf, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len)
        String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"recv freeing message buffer" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CString -> IO CInt
c_nn_freemsg CString
buf
        ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
str

-- | Nonblocking receive function.
recv' :: Receiver a => Socket a -> IO (Maybe ByteString)
recv' :: forall a. Receiver a => Socket a -> IO (Maybe ByteString)
recv' (Socket a
_ CInt
sid) =
    (Ptr CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
ptr -> do
        CInt
len <- CInt -> Ptr CString -> CSize -> CInt -> IO CInt
c_nn_recv CInt
sid Ptr CString
ptr (CSize
18446744073709551615) (CInt
1)
{-# LINE 492 "src/Nanomsg.hsc" #-}
        if CInt
len CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
>= CInt
0
            then do
                CString
buf <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
ptr
                ByteString
str <- CStringLen -> IO ByteString
C.packCStringLen (CString
buf, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len)
                String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"recv' freeing message buffer" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CString -> IO CInt
c_nn_freemsg CString
buf
                Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
str
            else do
                CInt
errno <- IO CInt
c_nn_errno
                if CInt
errno CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt
11) Bool -> Bool -> Bool
|| CInt
errno CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt
4)
{-# LINE 501 "src/Nanomsg.hsc" #-}
                    then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
                    else String -> IO (Maybe ByteString)
forall a. String -> IO a
throwErrno String
"recv'"

-- | Subscribe to a given subject string.
subscribe :: Socket Sub -> ByteString -> IO ()
subscribe :: Socket Sub -> ByteString -> IO ()
subscribe (Socket Sub
t CInt
sid) ByteString
string =
    Socket Sub -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption (Sub -> CInt -> Socket Sub
forall a. a -> CInt -> Socket a
Socket Sub
t CInt
sid) (Sub -> CInt
forall a. SocketType a => a -> CInt
socketType Sub
t) (CInt
1) (ByteString -> SocketOption
StringOption ByteString
string)
{-# LINE 508 "src/Nanomsg.hsc" #-}

-- | Unsubscribes from a subject.
unsubscribe :: Socket Sub -> ByteString -> IO ()
unsubscribe :: Socket Sub -> ByteString -> IO ()
unsubscribe (Socket Sub
t CInt
sid) ByteString
string =
    Socket Sub -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption (Sub -> CInt -> Socket Sub
forall a. a -> CInt -> Socket a
Socket Sub
t CInt
sid) (Sub -> CInt
forall a. SocketType a => a -> CInt
socketType Sub
t) (CInt
2) (ByteString -> SocketOption
StringOption ByteString
string)
{-# LINE 513 "src/Nanomsg.hsc" #-}

-- | Closes the socket. Any buffered inbound messages that were not yet
-- received by the application will be discarded. The library will try to
-- deliver any outstanding outbound messages for the time specified by
-- NN_LINGER socket option. The call will block in the meantime.
close :: Socket a -> IO ()
close :: forall a. Socket a -> IO ()
close (Socket a
_ CInt
sid) =
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"close" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> IO CInt
c_nn_close CInt
sid

-- | Switches nanomsg into shutdown modus and interrupts any waiting
-- function calls.
term :: IO ()
term :: IO ()
term = IO ()
c_nn_term


-- * Socket option accessors and mutators

-- not sure if this beats having setOptionInt and setOptionString..
data SocketOption = IntOption Int | StringOption ByteString
    deriving (Int -> SocketOption -> String -> String
[SocketOption] -> String -> String
SocketOption -> String
(Int -> SocketOption -> String -> String)
-> (SocketOption -> String)
-> ([SocketOption] -> String -> String)
-> Show SocketOption
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SocketOption -> String -> String
showsPrec :: Int -> SocketOption -> String -> String
$cshow :: SocketOption -> String
show :: SocketOption -> String
$cshowList :: [SocketOption] -> String -> String
showList :: [SocketOption] -> String -> String
Show)

-- Used for setting a socket option.
setOption :: Socket a -> CInt -> CInt -> SocketOption -> IO ()

setOption :: forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption (Socket a
_ CInt
sid) CInt
level CInt
option (IntOption Int
val) =
    (Ptr CInt -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO ()) -> IO ()) -> (Ptr CInt -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr -> do
        Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val :: CInt)
        let cintSize :: CSize
cintSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Storable a => a -> Int
sizeOf (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val :: CInt) :: CSize
        String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setOption (int)" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> Ptr CInt -> CSize -> IO CInt
forall a. CInt -> CInt -> CInt -> Ptr a -> CSize -> IO CInt
c_nn_setsockopt CInt
sid CInt
level CInt
option Ptr CInt
ptr CSize
cintSize

setOption (Socket a
_ CInt
sid) CInt
level CInt
option (StringOption ByteString
str) =
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setOption (string)" (IO CInt -> IO ())
-> ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt)
-> IO ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
U.unsafeUseAsCStringLen ByteString
str ((CStringLen -> IO CInt) -> IO ())
-> (CStringLen -> IO CInt) -> IO ()
forall a b. (a -> b) -> a -> b
$
        \(CString
ptr, Int
len) -> CInt -> CInt -> CInt -> CString -> CSize -> IO CInt
forall a. CInt -> CInt -> CInt -> Ptr a -> CSize -> IO CInt
c_nn_setsockopt CInt
sid CInt
level CInt
option CString
ptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

-- Reads a socket option.
getOption :: Socket a -> CInt -> CInt -> IO CInt
getOption :: forall a. Socket a -> CInt -> CInt -> IO CInt
getOption (Socket a
_ CInt
sid) CInt
level CInt
option =
    (Ptr CInt -> IO CInt) -> IO CInt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO CInt) -> IO CInt)
-> (Ptr CInt -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ptr ->
        (Ptr CSize -> IO CInt) -> IO CInt
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO CInt) -> IO CInt)
-> (Ptr CSize -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
sizePtr -> do
            let a :: CInt
a = CInt
1 :: CInt
            let cintSize :: CSize
cintSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
a
            Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
sizePtr CSize
cintSize
            String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"getOption" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> Ptr CInt -> Ptr CSize -> IO CInt
forall a. CInt -> CInt -> CInt -> Ptr a -> Ptr CSize -> IO CInt
c_nn_getsockopt CInt
sid CInt
level CInt
option (Ptr CInt
ptr :: Ptr CInt) Ptr CSize
sizePtr
            CInt
value <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ptr
            CSize
size <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
sizePtr
            if CSize
cintSize CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
/= CSize
size then String -> IO CInt
forall a. String -> IO a
throwErrno String
"getOption: output size not as expected" else CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
value

-- Retrieves a nanomsg file descriptor for polling ready status.
getOptionFd :: Socket a -> CInt -> IO Fd
getOptionFd :: forall a. Socket a -> CInt -> IO Fd
getOptionFd (Socket a
_ CInt
sid) CInt
option =
    (Ptr Fd -> IO Fd) -> IO Fd
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Fd -> IO Fd) -> IO Fd) -> (Ptr Fd -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \Ptr Fd
ptr ->
        (Ptr CSize -> IO Fd) -> IO Fd
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO Fd) -> IO Fd) -> (Ptr CSize -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
sizePtr -> do
            let a :: Fd
a = Fd
1 :: Fd
            let fdSize :: CSize
fdSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Fd -> Int
forall a. Storable a => a -> Int
sizeOf Fd
a
            Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
sizePtr CSize
fdSize
            String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"getOptionFd" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> Ptr Fd -> Ptr CSize -> IO CInt
forall a. CInt -> CInt -> CInt -> Ptr a -> Ptr CSize -> IO CInt
c_nn_getsockopt CInt
sid (CInt
0) CInt
option (Ptr Fd
ptr :: Ptr Fd) Ptr CSize
sizePtr
{-# LINE 569 "src/Nanomsg.hsc" #-}
            Fd
value <- Ptr Fd -> IO Fd
forall a. Storable a => Ptr a -> IO a
peek Ptr Fd
ptr
            CSize
size <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
sizePtr
            if CSize
fdSize CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
/= CSize
size then String -> IO Fd
forall a. String -> IO a
throwErrno String
"getOptionFd: output size not as expected" else Fd -> IO Fd
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fd
value

-- | Specifies how long the socket should try to send pending outbound
-- messages after close has been called, in milliseconds.
--
-- Negative value means infinite linger. Default value is 1000 (1 second).
linger :: Socket a -> IO Int
linger :: forall a. Socket a -> IO Int
linger Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
1)
{-# LINE 580 "src/Nanomsg.hsc" #-}
{-# DEPRECATED linger "NN_LINGER is no longer supported by nanomsg" #-}

-- | Specifies how long should the socket try to send pending outbound
-- messages after close has been called, in milliseconds.
--
-- Negative value means infinite linger. Default value is 1000 (1 second).
setLinger :: Socket a -> Int -> IO ()
setLinger :: forall a. Socket a -> Int -> IO ()
setLinger Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
1) (Int -> SocketOption
IntOption Int
val)
{-# LINE 589 "src/Nanomsg.hsc" #-}
{-# DEPRECATED setLinger "NN_LINGER is no longer supported by nanomsg" #-}

-- | Size of the send buffer, in bytes. To prevent blocking for messages
-- larger than the buffer, exactly one message may be buffered in addition
-- to the data in the send buffer.
--
-- Default value is 128kB.
sndBuf :: Socket a -> IO Int
sndBuf :: forall a. Socket a -> IO Int
sndBuf Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
2)
{-# LINE 599 "src/Nanomsg.hsc" #-}

-- | Size of the send buffer, in bytes. To prevent blocking for messages
-- larger than the buffer, exactly one message may be buffered in addition
-- to the data in the send buffer.
--
-- Default value is 128kB.
setSndBuf :: Socket a -> Int -> IO ()
setSndBuf :: forall a. Socket a -> Int -> IO ()
setSndBuf Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
2) (Int -> SocketOption
IntOption Int
val)
{-# LINE 608 "src/Nanomsg.hsc" #-}

-- | Size of the receive buffer, in bytes. To prevent blocking for messages
-- larger than the buffer, exactly one message may be buffered in addition
-- to the data in the receive buffer.
--
-- Default value is 128kB.
rcvBuf :: Socket a -> IO Int
rcvBuf :: forall a. Socket a -> IO Int
rcvBuf Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
3)
{-# LINE 617 "src/Nanomsg.hsc" #-}

-- | Size of the receive buffer, in bytes. To prevent blocking for messages
-- larger than the buffer, exactly one message may be buffered in addition
-- to the data in the receive buffer.
--
-- Default value is 128kB.
setRcvBuf :: Socket a -> Int -> IO ()
setRcvBuf :: forall a. Socket a -> Int -> IO ()
setRcvBuf Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
3) (Int -> SocketOption
IntOption Int
val)
{-# LINE 626 "src/Nanomsg.hsc" #-}

-- | Maximum message size that can be received, in bytes.
-- Negative value means that the received size is limited only by available addressable memory.
-- The type of this option is int.
--
-- Default is 1024kB.
rcvMaxSize :: Socket a -> IO Int
rcvMaxSize :: forall a. Socket a -> IO Int
rcvMaxSize Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
16)
{-# LINE 635 "src/Nanomsg.hsc" #-}

-- | Maximum message size that can be received, in bytes.
-- Negative value means that the received size is limited only by available addressable memory.
-- The type of this option is int.
--
-- Default is 1024kB.
setRcvMaxSize :: Socket a -> Int -> IO ()
setRcvMaxSize :: forall a. Socket a -> Int -> IO ()
setRcvMaxSize Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
16) (Int -> SocketOption
IntOption Int
val)
{-# LINE 644 "src/Nanomsg.hsc" #-}

-- Think I'll just skip these. There's recv' for nonblocking receive, and
-- adding a return value to send seems awkward.
--sendTimeout
--recvTimeout

-- | For connection-based transports such as TCP, this option specifies
-- how long to wait, in milliseconds, when connection is broken before
-- trying to re-establish it.
--
-- Note that actual reconnect interval may be randomised to some extent
-- to prevent severe reconnection storms.
--
-- Default value is 100 (0.1 second).
reconnectInterval :: Socket a -> IO Int
reconnectInterval :: forall a. Socket a -> IO Int
reconnectInterval Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
6)
{-# LINE 661 "src/Nanomsg.hsc" #-}

-- | For connection-based transports such as TCP, this option specifies
-- how long to wait, in milliseconds, when connection is broken before
-- trying to re-establish it.
--
-- Note that actual reconnect interval may be randomised to some extent
-- to prevent severe reconnection storms.
--
-- Default value is 100 (0.1 second).
setReconnectInterval :: Socket a -> Int -> IO ()
setReconnectInterval :: forall a. Socket a -> Int -> IO ()
setReconnectInterval Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
6) (Int -> SocketOption
IntOption Int
val)
{-# LINE 673 "src/Nanomsg.hsc" #-}

-- | This option is to be used only in addition to NN_RECONNECT_IVL option.
-- It specifies maximum reconnection interval. On each reconnect attempt,
-- the previous interval is doubled until NN_RECONNECT_IVL_MAX is reached.
--
-- Value of zero means that no exponential backoff is performed and reconnect
-- interval is based only on NN_RECONNECT_IVL. If NN_RECONNECT_IVL_MAX is
-- less than NN_RECONNECT_IVL, it is ignored.
--
-- Default value is 0.
reconnectIntervalMax :: Socket a -> IO Int
reconnectIntervalMax :: forall a. Socket a -> IO Int
reconnectIntervalMax Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
7)
{-# LINE 686 "src/Nanomsg.hsc" #-}

-- | This option is to be used only in addition to NN_RECONNECT_IVL option.
-- It specifies maximum reconnection interval. On each reconnect attempt,
-- the previous interval is doubled until NN_RECONNECT_IVL_MAX is reached.
--
-- Value of zero means that no exponential backoff is performed and reconnect
-- interval is based only on NN_RECONNECT_IVL. If NN_RECONNECT_IVL_MAX is
-- less than NN_RECONNECT_IVL, it is ignored.
--
-- Default value is 0.
setReconnectIntervalMax :: Socket a -> Int -> IO ()
setReconnectIntervalMax :: forall a. Socket a -> Int -> IO ()
setReconnectIntervalMax Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
7) (Int -> SocketOption
IntOption Int
val)
{-# LINE 699 "src/Nanomsg.hsc" #-}

-- | Sets outbound priority for endpoints subsequently added to the socket.
-- This option has no effect on socket types that send messages to all the
-- peers. However, if the socket type sends each message to a single peer
-- (or a limited set of peers), peers with high priority take precedence over
-- peers with low priority.
--
-- Highest priority is 1, lowest priority is 16. Default value is 8.
sndPrio :: Socket a -> IO Int
sndPrio :: forall a. Socket a -> IO Int
sndPrio Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
8)
{-# LINE 710 "src/Nanomsg.hsc" #-}

-- | Sets outbound priority for endpoints subsequently added to the socket.
-- This option has no effect on socket types that send messages to all the
-- peers. However, if the socket type sends each message to a single peer
-- (or a limited set of peers), peers with high priority take precedence over
-- peers with low priority.
--
-- Highest priority is 1, lowest priority is 16. Default value is 8.
setSndPrio :: Socket a -> Int -> IO ()
setSndPrio :: forall a. Socket a -> Int -> IO ()
setSndPrio Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
8) (Int -> SocketOption
IntOption Int
val)
{-# LINE 721 "src/Nanomsg.hsc" #-}

-- | If set to 1, only IPv4 addresses are used. If set to 0, both IPv4
-- and IPv6 addresses are used.
--
-- Default value is 1.
ipv4Only :: Socket a -> IO Int
ipv4Only :: forall a. Socket a -> IO Int
ipv4Only Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (CInt
0) (CInt
14)
{-# LINE 729 "src/Nanomsg.hsc" #-}

-- | If set to 1, only IPv4 addresses are used. If set to 0, both IPv4
-- and IPv6 addresses are used.
--
-- Default value is 1.
setIpv4Only :: Socket a -> Int -> IO ()
setIpv4Only :: forall a. Socket a -> Int -> IO ()
setIpv4Only Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (CInt
0) (CInt
14) (Int -> SocketOption
IntOption Int
val)
{-# LINE 737 "src/Nanomsg.hsc" #-}

-- | This option is defined on the full REQ socket. If reply is not received
-- in specified amount of milliseconds, the request will be automatically
-- resent.
--
-- Default value is 60000 (1 minute).
requestResendInterval :: Socket Req -> IO Int
requestResendInterval :: Socket Req -> IO Int
requestResendInterval Socket Req
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket Req -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket Req
s (CInt
48) (CInt
1)
{-# LINE 746 "src/Nanomsg.hsc" #-}

-- | This option is defined on the full REQ socket. If reply is not received
-- in specified amount of milliseconds, the request will be automatically
-- resent.
--
-- Default value is 60000 (1 minute).
setRequestResendInterval :: Socket Req -> Int -> IO ()
setRequestResendInterval :: Socket Req -> Int -> IO ()
setRequestResendInterval Socket Req
s Int
val =
    Socket Req -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket Req
s (CInt
48) (CInt
1) (Int -> SocketOption
IntOption Int
val)
{-# LINE 755 "src/Nanomsg.hsc" #-}

-- | Get timeout for Surveyor sockets
surveyorDeadline :: Socket Surveyor -> IO Int
surveyorDeadline :: Socket Surveyor -> IO Int
surveyorDeadline Socket Surveyor
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket Surveyor -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket Surveyor
s (CInt
98) (CInt
1)
{-# LINE 760 "src/Nanomsg.hsc" #-}

-- | Set timeout for Surveyor sockets
setSurveyorDeadline :: Socket Surveyor -> Int -> IO ()
setSurveyorDeadline :: Socket Surveyor -> Int -> IO ()
setSurveyorDeadline Socket Surveyor
s Int
val =
    Socket Surveyor -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket Surveyor
s (CInt
98) (CInt
1) (Int -> SocketOption
IntOption Int
val)
{-# LINE 765 "src/Nanomsg.hsc" #-}

-- | This option, when set to 1, disables Nagle's algorithm.
--
-- Default value is 0.
tcpNoDelay :: Socket a -> IO Int
tcpNoDelay :: forall a. Socket a -> IO Int
tcpNoDelay Socket a
s =
    CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket a -> CInt -> CInt -> IO CInt
forall a. Socket a -> CInt -> CInt -> IO CInt
getOption Socket a
s (-CInt
3) (CInt
1)
{-# LINE 772 "src/Nanomsg.hsc" #-}

-- | This option, when set to 1, disables Nagle's algorithm.
--
-- Default value is 0.
setTcpNoDelay :: Socket a -> Int -> IO ()
setTcpNoDelay :: forall a. Socket a -> Int -> IO ()
setTcpNoDelay Socket a
s Int
val =
    Socket a -> CInt -> CInt -> SocketOption -> IO ()
forall a. Socket a -> CInt -> CInt -> SocketOption -> IO ()
setOption Socket a
s (-CInt
3) (CInt
1) (Int -> SocketOption
IntOption Int
val)
{-# LINE 779 "src/Nanomsg.hsc" #-}