-- | Provides configuration functions to handle setting up non-default
-- options and toggles.
module Network.Zyre2.Configuration where

import Data.Text (Text)
import qualified Data.Text as T
import Foreign.C.String (newCString)
import Foreign.Marshal.Alloc (free)
import Network.Zyre2.Bindings
  ( zyreSetEvasiveTimeout,
    zyreSetExpiredTimeout,
    zyreSetHeader,
    zyreSetInterface,
    zyreSetInterval,
    zyreSetName,
    zyreSetPort,
    zyreSetSilentTimeout,
    zyreSetVerbose,
  )
import Network.Zyre2.Types (ZCreated, ZyreContext (ZyreContext), unlessStale)

-- | Set the name of the context.
setName :: ZyreContext ZCreated -> Text -> IO ()
setName :: ZyreContext ZCreated -> Text -> IO ()
setName zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
name = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  CString
cname <- String -> IO CString
newCString (Text -> String
T.unpack Text
name)
  Ptr () -> CString -> IO ()
zyreSetName Ptr ()
ptr CString
cname
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname

-- | Set a header value. Headers are sent with every 'Enter' message.
setHeader :: ZyreContext ZCreated -> Text -> Text -> IO ()
setHeader :: ZyreContext ZCreated -> Text -> Text -> IO ()
setHeader zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
headerName Text
headerValue = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  CString
cheaderName <- String -> IO CString
newCString (Text -> String
T.unpack Text
headerName)
  CString
cheaderValue <- String -> IO CString
newCString (Text -> String
T.unpack Text
headerValue)
  Ptr () -> CString -> CString -> IO ()
zyreSetHeader Ptr ()
ptr CString
cheaderName CString
cheaderValue
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cheaderName
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cheaderValue

-- | Enable verbose mode, logging most actions zyre does.
setVerbose :: ZyreContext ZCreated -> IO ()
setVerbose :: ZyreContext ZCreated -> IO ()
setVerbose zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr () -> IO ()
zyreSetVerbose Ptr ()
ptr

-- | Set a specific port that zyre uses. By default zyre uses an ephemereal port.
setPort :: ZyreContext ZCreated -> Int -> IO ()
setPort :: ZyreContext ZCreated -> Int -> IO ()
setPort zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Int
port = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr () -> CInt -> IO ()
zyreSetPort Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
port)

-- | Set the time in milliseconds for a node to be considered evasive.
-- Default is 5000.
setEvasiveTimeout :: ZyreContext ZCreated -> Int -> IO ()
setEvasiveTimeout :: ZyreContext ZCreated -> Int -> IO ()
setEvasiveTimeout zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Int
timeout = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr () -> CInt -> IO ()
zyreSetEvasiveTimeout Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout)

-- | Set the time in milliseconds for a node to be considered silent.
-- Default is 5000.
setSilentTimeout :: ZyreContext ZCreated -> Int -> IO ()
setSilentTimeout :: ZyreContext ZCreated -> Int -> IO ()
setSilentTimeout zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Int
timeout = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr () -> CInt -> IO ()
zyreSetSilentTimeout Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout)

-- | Set the time in milliseconds for a node to be considered expired.
-- Default is 30000.
setExpiredTimeout :: ZyreContext ZCreated -> Int -> IO ()
setExpiredTimeout :: ZyreContext ZCreated -> Int -> IO ()
setExpiredTimeout zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Int
timeout = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr () -> CInt -> IO ()
zyreSetExpiredTimeout Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout)

-- | Set the UDP beaconing interval. A node will instantly beacon on
-- connecting, regardless of interval.
-- Default is 1000.
setInterval :: ZyreContext ZCreated -> Int -> IO ()
setInterval :: ZyreContext ZCreated -> Int -> IO ()
setInterval zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Int
interval = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr () -> CInt -> IO ()
zyreSetInterval Ptr ()
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
interval)

-- | Set network interface for UDP beacons. If you do not set this, CZMQ will
-- choose an interface for you. On boxes with several interfaces you should
-- specify which one you want to use, or strange things can happen.
setInterface :: ZyreContext ZCreated -> Text -> IO ()
setInterface :: ZyreContext ZCreated -> Text -> IO ()
setInterface zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
interface = ZyreContext ZCreated -> IO () -> IO ()
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  CString
cinterface <- String -> IO CString
newCString (Text -> String
T.unpack Text
interface)
  Ptr () -> CString -> IO ()
zyreSetInterface Ptr ()
ptr CString
cinterface
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cinterface