-- | Zyre provides reliable group messaging over local area networks. It has these key characteristics:
--
-- * Zyre needs no administration or configuration.
-- * Peers may join and leave the network at any time.
-- * Peers talk to each other without any central brokers or servers.
-- * Peers can talk directly to each other.
-- * Peers can join groups, and then talk to groups.
-- * Zyre is reliable, and loses no messages even when the network is heavily loaded.
-- * Zyre is fast and has low latency, requiring no consensus protocols.
-- * Zyre is designed for WiFi networks, yet also works well on Ethernet networks.
-- * Time for a new peer to join a network is about one second.
--
-- Typical use cases for Zyre are:
--
-- * Local service discovery.
-- * Clustering of a set of services on the same Ethernet network.
-- * Controlling a network of smart devices (Internet of Things).
-- * Multi-user mobile applications (like smart classrooms).
--
-- This package provides a haskell interface to the Zyre 2.0 API. The
-- package requires the c libraries czmq and zyre to be installed on the
-- system. See https://github.com/zeromq/zyre for specifics.
module Network.Zyre2.Zyre
  ( name,
    new,
    start,
    stop,
    destroy,
    join,
    leave,
    uuid,
    version,
    shout,
    shouts,
    whisper,
    whispers,
    recv,
    peers,
    peerAddress,
    peerName,
    peerHeaderValue,
    peersByGroup,
    ownGroups,
    peerGroups,
  )
where

import Control.Exception (throw)
import Control.Monad (forM, forM_, unless, void)
import qualified Data.ByteString as BS
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word64)
import Foreign.C.String (newCString, peekCString)
import Foreign.Marshal.Alloc (free)
import Foreign.Ptr (Ptr, nullPtr)
import qualified Network.Zyre2.Bindings as ZB
import Network.Zyre2.Types
  ( ZCreated,
    ZDestroyed,
    ZRunning,
    ZStopped,
    ZyreContext (ZyreContext),
    unlessStale,
  )
import qualified Network.Zyre2.ZMsg as ZM

-- | Create a new Zyre instance/context.
-- All created contexts must be manually cleaned up with 'destroy' to avoid leaks.
-- Takes a node name, or if 'Nothing' will auto-generate a name from the node UUID.
new :: Maybe Text -> IO (ZyreContext ZCreated)
new :: Maybe Text -> IO (ZyreContext ZCreated)
new Maybe Text
name = do
  CString
cname <- case Maybe Text
name of
    Just Text
t -> String -> IO CString
newCString (Text -> String
T.unpack Text
t)
    Maybe Text
Nothing -> CString -> IO CString
forall (f :: * -> *) a. Applicative f => a -> f a
pure CString
forall a. Ptr a
nullPtr
  Ptr ()
ptr <- CString -> IO (Ptr ())
ZB.zyreNew CString
cname
  case Maybe Text
name of
    Just Text
_ -> CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
    Maybe Text
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  IORef Bool
stale <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  IORef (Map Text Text)
nameMap <- Map Text Text -> IO (IORef (Map Text Text))
forall a. a -> IO (IORef a)
newIORef Map Text Text
forall k a. Map k a
Map.empty
  let ctx :: ZyreContext ZCreated
ctx = Ptr ()
-> IORef Bool -> IORef (Map Text Text) -> ZyreContext ZCreated
forall state.
Ptr () -> IORef Bool -> IORef (Map Text Text) -> ZyreContext state
ZyreContext Ptr ()
ptr IORef Bool
stale IORef (Map Text Text)
nameMap :: ZyreContext ZCreated
  ZyreContext ZCreated -> IO (ZyreContext ZCreated)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZyreContext ZCreated
ctx

-- | Start the zyre instance. Starts UDP beaconing and joins the
-- peer network. Generates an 'Enter' message for other participants.
start :: ZyreContext ZCreated -> IO (ZyreContext ZRunning)
start :: ZyreContext ZCreated -> IO (ZyreContext ZRunning)
start zctx :: ZyreContext ZCreated
zctx@(ZyreContext Ptr ()
ptr IORef Bool
stale IORef (Map Text Text)
nameMap) = ZyreContext ZCreated
-> IO (ZyreContext ZRunning) -> IO (ZyreContext ZRunning)
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZCreated
zctx (IO (ZyreContext ZRunning) -> IO (ZyreContext ZRunning))
-> IO (ZyreContext ZRunning) -> IO (ZyreContext ZRunning)
forall a b. (a -> b) -> a -> b
$ do
  IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> (Ptr () -> IO CInt) -> Ptr () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO CInt
ZB.zyreStart (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ()
ptr
  IORef Bool
newStale <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  let ctx :: ZyreContext ZRunning
ctx = Ptr ()
-> IORef Bool -> IORef (Map Text Text) -> ZyreContext ZRunning
forall state.
Ptr () -> IORef Bool -> IORef (Map Text Text) -> ZyreContext state
ZyreContext Ptr ()
ptr IORef Bool
newStale IORef (Map Text Text)
nameMap :: ZyreContext ZRunning
  IORef Bool -> (Bool -> (Bool, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Bool
stale ((Bool, ()) -> Bool -> (Bool, ())
forall a b. a -> b -> a
const (Bool
True, ()))
  ZyreContext ZRunning -> IO (ZyreContext ZRunning)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZyreContext ZRunning
ctx

-- | Stop the zyre instance, leaving the peer network.
-- Generates a 'Exit' message for the other participants.
stop :: ZyreContext ZRunning -> IO (ZyreContext ZStopped)
stop :: ZyreContext ZRunning -> IO (ZyreContext ZStopped)
stop zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
stale IORef (Map Text Text)
nameMap) = ZyreContext ZRunning
-> IO (ZyreContext ZStopped) -> IO (ZyreContext ZStopped)
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO (ZyreContext ZStopped) -> IO (ZyreContext ZStopped))
-> IO (ZyreContext ZStopped) -> IO (ZyreContext ZStopped)
forall a b. (a -> b) -> a -> b
$ do
  IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> (Ptr () -> IO ()) -> Ptr () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> IO ()
ZB.zyreStop (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ()
ptr
  IORef Bool
newStale <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  let ctx :: ZyreContext ZStopped
ctx = Ptr ()
-> IORef Bool -> IORef (Map Text Text) -> ZyreContext ZStopped
forall state.
Ptr () -> IORef Bool -> IORef (Map Text Text) -> ZyreContext state
ZyreContext Ptr ()
ptr IORef Bool
newStale IORef (Map Text Text)
nameMap :: ZyreContext ZStopped
  IORef Bool -> (Bool -> (Bool, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Bool
stale ((Bool, ()) -> Bool -> (Bool, ())
forall a b. a -> b -> a
const (Bool
True, ()))
  ZyreContext ZStopped -> IO (ZyreContext ZStopped)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZyreContext ZStopped
ctx

-- | Destroy the given zyre context, freeing its resources.
-- Once it has been destroyed, it can no longer be used.
-- Returns a ZyreContext tagged as destroyed to maintain an API
-- similar to the rest of the interface.
destroy :: ZyreContext ZStopped -> IO (ZyreContext ZDestroyed)
destroy :: ZyreContext ZStopped -> IO (ZyreContext ZDestroyed)
destroy zctx :: ZyreContext ZStopped
zctx@(ZyreContext Ptr ()
ptr IORef Bool
stale IORef (Map Text Text)
nameMap) = ZyreContext ZStopped
-> IO (ZyreContext ZDestroyed) -> IO (ZyreContext ZDestroyed)
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZStopped
zctx (IO (ZyreContext ZDestroyed) -> IO (ZyreContext ZDestroyed))
-> IO (ZyreContext ZDestroyed) -> IO (ZyreContext ZDestroyed)
forall a b. (a -> b) -> a -> b
$ do
  Ptr () -> IO ()
ZB.zyreDestroy Ptr ()
ptr
  let ctx :: ZyreContext ZDestroyed
ctx = Ptr ()
-> IORef Bool -> IORef (Map Text Text) -> ZyreContext ZDestroyed
forall state.
Ptr () -> IORef Bool -> IORef (Map Text Text) -> ZyreContext state
ZyreContext Ptr ()
ptr IORef Bool
stale IORef (Map Text Text)
nameMap :: ZyreContext ZDestroyed
  IORef Bool -> (Bool -> (Bool, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Bool
stale ((Bool, ()) -> Bool -> (Bool, ())
forall a b. a -> b -> a
const (Bool
True, ()))
  ZyreContext ZDestroyed -> IO (ZyreContext ZDestroyed)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ZyreContext ZDestroyed
ctx

-- | Join a peer group, to start receiving and be able to send
-- messages from that group. Generates a 'Join' message for
-- the other participants in the group.
join :: ZyreContext ZRunning -> Text -> IO Int
join :: ZyreContext ZRunning -> Text -> IO Int
join zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
name = ZyreContext ZRunning -> IO Int -> IO Int
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
  CString
cname <- String -> IO CString
newCString (Text -> String
T.unpack Text
name)
  CInt
cint <- Ptr () -> CString -> IO CInt
ZB.zyreJoin Ptr ()
ptr CString
cname
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
  Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint

-- | Leave a peer group, and stop receiving updates from that group.
-- Generates a 'Leave' message for the other participants in the
-- group network.
leave :: ZyreContext ZRunning -> Text -> IO Int
leave :: ZyreContext ZRunning -> Text -> IO Int
leave zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
name = ZyreContext ZRunning -> IO Int -> IO Int
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
  CString
cname <- String -> IO CString
newCString (Text -> String
T.unpack Text
name)
  CInt
cint <- Ptr () -> CString -> IO CInt
ZB.zyreLeave Ptr ()
ptr CString
cname
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
  Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint

-- | Retrieve the UUID generated for the context.
uuid :: ZyreContext a -> IO Text
uuid :: ZyreContext a -> IO Text
uuid zctx :: ZyreContext a
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) = ZyreContext a -> IO Text -> IO Text
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext a
zctx (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ do
  CString
cstring <- Ptr () -> IO CString
ZB.zyreUuid Ptr ()
ptr
  String
str <- CString -> IO String
peekCString CString
cstring IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cstring
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str

-- | Retrieve the version of underlying zyre library.
version :: IO Word64
version :: IO Word64
version = IO Word64
ZB.zyreVersion

-- | Retrieve the name of our node after initialization. Either set by 'new'
-- or automatically generated by zyre from the nodes UUID.
name :: ZyreContext a -> IO Text
name :: ZyreContext a -> IO Text
name zctx :: ZyreContext a
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) = ZyreContext a -> IO Text -> IO Text
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext a
zctx (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$ do
  CString
cstring <- Ptr () -> IO CString
ZB.zyreName Ptr ()
ptr
  String
str <- CString -> IO String
peekCString CString
cstring IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cstring
  Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str

-- | Shout a 'Shout' to a group. Sends data frames.
--
-- > ctx <- new "my-node"
-- > ctx <- start ctx
-- > join ctx "my-group"
-- > let msg = addString "My message" msgShout
-- > shout ctx "my-group" msg
--
-- You can also send multiple frames in the same message.
--
-- > let msg = addString "Frame2" . addString "Frame1" $ msgShout
shout :: ZyreContext ZRunning -> Text -> ZM.ZMsg -> IO Int
shout :: ZyreContext ZRunning -> Text -> ZMsg -> IO Int
shout zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
room zmsg :: ZMsg
zmsg@ZM.Shout {} = ZyreContext ZRunning -> IO Int -> IO Int
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
  Ptr ()
msg_ptr <- IO (Ptr ())
ZB.zyreNewZMsg
  CString
croom <- String -> IO CString
newCString (Text -> String
T.unpack Text
room)
  [ZFrame] -> (ZFrame -> IO CInt) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ZMsg -> [ZFrame]
ZM._zmsgMessage ZMsg
zmsg) ((ZFrame -> IO CInt) -> IO ()) -> (ZFrame -> IO CInt) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZFrame
frame -> Ptr () -> ByteString -> IO CInt
ZB.zyreAddFrame Ptr ()
msg_ptr (ZFrame -> ByteString
ZM.frameData ZFrame
frame)
  CInt
cint <- Ptr () -> CString -> Ptr () -> IO CInt
ZB.zyreShout Ptr ()
ptr CString
croom Ptr ()
msg_ptr
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
croom
  Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint
shout ZyreContext ZRunning
_ Text
_ ZMsg
_ = Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)

-- | Shout a 'Shout' to a group. Sends some 'Text' value encoded as a 'Data.ByteString.ByteString'.
--
-- > ctx <- new "my-node"
-- > ctx <- start ctx
-- > join ctx "my-group"
-- > shout ctx "my-group" "My message"
shouts :: ZyreContext ZRunning -> Text -> Text -> IO Int
shouts :: ZyreContext ZRunning -> Text -> Text -> IO Int
shouts zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
room Text
msg = ZyreContext ZRunning -> IO Int -> IO Int
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
  CString
croom <- String -> IO CString
newCString (Text -> String
T.unpack Text
room)
  CString
cmsg <- String -> IO CString
newCString (Text -> String
T.unpack Text
msg)
  CInt
cint <- Ptr () -> CString -> CString -> IO CInt
ZB.zyreShouts Ptr ()
ptr CString
croom CString
cmsg
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
croom
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cmsg
  Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint

-- | Whisper a 'Whisper' to a specific peer. Takes a node id and a 'ZMsg'. Sends data frames.
whisper :: ZyreContext ZRunning -> Text -> ZM.ZMsg -> IO Int
whisper :: ZyreContext ZRunning -> Text -> ZMsg -> IO Int
whisper zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
peer zmsg :: ZMsg
zmsg@ZM.Whisper {} = ZyreContext ZRunning -> IO Int -> IO Int
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
  Ptr ()
msg_ptr <- IO (Ptr ())
ZB.zyreNewZMsg
  CString
cpeer <- String -> IO CString
newCString (Text -> String
T.unpack Text
peer)
  [ZFrame] -> (ZFrame -> IO CInt) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ZMsg -> [ZFrame]
ZM._zmsgMessage ZMsg
zmsg) ((ZFrame -> IO CInt) -> IO ()) -> (ZFrame -> IO CInt) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ZFrame
frame -> Ptr () -> ByteString -> IO CInt
ZB.zyreAddFrame Ptr ()
msg_ptr (ZFrame -> ByteString
ZM.frameData ZFrame
frame)
  CInt
cint <- Ptr () -> CString -> Ptr () -> IO CInt
ZB.zyreWhisper Ptr ()
ptr CString
cpeer Ptr ()
msg_ptr
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cpeer
  Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint
whisper ZyreContext ZRunning
_ Text
_ ZMsg
_ = Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)

-- | Whisper a 'Whisper' to a specific peer. Sends some 'Text' value encoded as a 'Data.ByteString.ByteString'.
whispers :: ZyreContext ZRunning -> Text -> Text -> IO Int
whispers :: ZyreContext ZRunning -> Text -> Text -> IO Int
whispers zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
peer Text
msg = ZyreContext ZRunning -> IO Int -> IO Int
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
  CString
cpeer <- String -> IO CString
newCString (Text -> String
T.unpack Text
peer)
  CString
cmsg <- String -> IO CString
newCString (Text -> String
T.unpack Text
msg)
  CInt
cint <- Ptr () -> CString -> CString -> IO CInt
ZB.zyreWhispers Ptr ()
ptr CString
cpeer CString
cmsg
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cpeer
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cmsg
  Int -> IO Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cint

-- | Block and await a message from the peer network.
-- Returns 'Nothing' if it times out or is interruped.
recv :: ZyreContext ZRunning -> IO (Maybe ZM.ZMsg)
recv :: ZyreContext ZRunning -> IO (Maybe ZMsg)
recv zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
nameMap) = ZyreContext ZRunning -> IO (Maybe ZMsg) -> IO (Maybe ZMsg)
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO (Maybe ZMsg) -> IO (Maybe ZMsg))
-> IO (Maybe ZMsg) -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$ do
  -- Block and listen for a msg, receive a pointer to msg or null.
  Ptr () -> IO (Ptr ())
ZB.zyreRecv Ptr ()
ptr IO (Ptr ()) -> (Ptr () -> IO (Maybe ZMsg)) -> IO (Maybe ZMsg)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
msg_ptr -> do
    if Ptr ()
msg_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
      then Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ZMsg
forall a. Maybe a
Nothing
      else do
        -- Check first frame for message type
        CString
cmsgType <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
        String
msgType <- CString -> IO String
peekCString CString
cmsgType IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cmsgType

        -- Parse remaining frames depending on message type
        Maybe ZMsg
maybeMsg <- case String
msgType of
          String
"ENTER" -> Ptr () -> IORef (Map Text Text) -> IO (Maybe ZMsg)
parseEnterMessage Ptr ()
msg_ptr IORef (Map Text Text)
nameMap
          String
"EVASIVE" -> Ptr () -> IO (Maybe ZMsg)
parseEvasiveMessage Ptr ()
msg_ptr
          String
"SILENT" -> Ptr () -> IO (Maybe ZMsg)
parseSilentMessage Ptr ()
msg_ptr
          String
"EXIT" -> Ptr () -> IORef (Map Text Text) -> IO (Maybe ZMsg)
forall a. Ptr () -> IORef (Map Text a) -> IO (Maybe ZMsg)
parseExitMessage Ptr ()
msg_ptr IORef (Map Text Text)
nameMap
          String
"JOIN" -> Ptr () -> IO (Maybe ZMsg)
parseJoinMessage Ptr ()
msg_ptr
          String
"LEAVE" -> Ptr () -> IO (Maybe ZMsg)
parseLeaveMessage Ptr ()
msg_ptr
          String
"WHISPER" -> Ptr () -> IO (Maybe ZMsg)
parseWhisperMessage Ptr ()
msg_ptr
          String
"SHOUT" -> Ptr () -> IO (Maybe ZMsg)
parseShoutMessage Ptr ()
msg_ptr
          String
"STOP" -> Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$ ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just ZMsg
ZM.Stop

          -- If we encounter an unknown message type
          String
_ -> do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unhandled msgType: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msgType
            Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ZMsg
forall a. Maybe a
Nothing
        -- Clean up zmsg
        Ptr () -> IO ()
ZB.zyreZmsgDestroy Ptr ()
msg_ptr
        Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ZMsg
maybeMsg
  where
    parseEnterMessage :: Ptr () -> IORef (Map Text Text) -> IO (Maybe ZMsg)
parseEnterMessage Ptr ()
msg_ptr IORef (Map Text Text)
nameMap = do
      -- Pop the message metadata off the zmsg, marshal into haskell types.
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      Ptr ()
cheader_ptr <- Ptr () -> IO (Ptr ())
ZB.zyrePopFrame Ptr ()
msg_ptr
      CString
cipport <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname  IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
      String
ipport <- CString -> IO String
peekCString CString
cipport IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cipport

      -- Unpack the headers
      IORef [(Text, Text)]
headersRef <- [(Text, Text)] -> IO (IORef [(Text, Text)])
forall a. a -> IO (IORef a)
newIORef []
      Ptr ()
headers_ptr <- Ptr () -> IO (Ptr ())
ZB.zyreUnpackHeaders Ptr ()
cheader_ptr
      Ptr () -> IORef [(Text, Text)] -> IO ()
extractHeaders Ptr ()
headers_ptr IORef [(Text, Text)]
headersRef
      Ptr () -> IO ()
ZB.zyreDestroyHeaders Ptr ()
headers_ptr
      [(Text, Text)]
headers <- IORef [(Text, Text)] -> IO [(Text, Text)]
forall a. IORef a -> IO a
readIORef IORef [(Text, Text)]
headersRef

      -- Release the allocated resources
      Ptr () -> IO ()
ZB.zyreDestroyFrame Ptr ()
cheader_ptr

      -- Add the node name to our mapping
      IORef (Map Text Text)
-> (Map Text Text -> (Map Text Text, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Map Text Text)
nameMap (\Map Text Text
x -> (Text -> Text -> Map Text Text -> Map Text Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (String -> Text
T.pack String
fromnode) (String -> Text
T.pack String
name) Map Text Text
x, ()))

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Enter :: Text -> Text -> [(Text, Text)] -> Text -> ZMsg
ZM.Enter
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name,
              _zmsgHeaders :: [(Text, Text)]
ZM._zmsgHeaders = [(Text, Text)]
headers,
              _zmsgIpPort :: Text
ZM._zmsgIpPort = String -> Text
T.pack String
ipport
            }

    parseEvasiveMessage :: Ptr () -> IO (Maybe ZMsg)
parseEvasiveMessage Ptr ()
msg_ptr = do
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Evasive :: Text -> Text -> ZMsg
ZM.Evasive
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name
            }

    parseSilentMessage :: Ptr () -> IO (Maybe ZMsg)
parseSilentMessage Ptr ()
msg_ptr = do
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Silent :: Text -> Text -> ZMsg
ZM.Silent
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name
            }

    parseExitMessage :: Ptr () -> IORef (Map Text a) -> IO (Maybe ZMsg)
parseExitMessage Ptr ()
msg_ptr IORef (Map Text a)
nameMap = do
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname

      -- Remove the node name from our mapping
      IORef (Map Text a) -> (Map Text a -> (Map Text a, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Map Text a)
nameMap (\Map Text a
x -> (Text -> Map Text a -> Map Text a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (String -> Text
T.pack String
fromnode) Map Text a
x, ()))

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Exit :: Text -> Text -> ZMsg
ZM.Exit
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name
            }

    parseJoinMessage :: Ptr () -> IO (Maybe ZMsg)
parseJoinMessage Ptr ()
msg_ptr = do
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cgroupname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
      String
groupname <- CString -> IO String
peekCString CString
cgroupname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cgroupname

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Join :: Text -> Text -> Text -> ZMsg
ZM.Join
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name,
              _zmsgGroupName :: Text
ZM._zmsgGroupName = String -> Text
T.pack String
groupname
            }

    parseLeaveMessage :: Ptr () -> IO (Maybe ZMsg)
parseLeaveMessage Ptr ()
msg_ptr = do
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cgroupname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
      String
groupname <- CString -> IO String
peekCString CString
cgroupname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cgroupname

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Leave :: Text -> Text -> Text -> ZMsg
ZM.Leave
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name,
              _zmsgGroupName :: Text
ZM._zmsgGroupName = String -> Text
T.pack String
groupname
            }

    parseWhisperMessage :: Ptr () -> IO (Maybe ZMsg)
parseWhisperMessage Ptr ()
msg_ptr = do
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname

      IORef [ZFrame]
msgBodyRef <- [ZFrame] -> IO (IORef [ZFrame])
forall a. a -> IO (IORef a)
newIORef []
      Ptr () -> IORef [ZFrame] -> IO ()
extractFrames Ptr ()
msg_ptr IORef [ZFrame]
msgBodyRef
      [ZFrame]
msgBody <- IORef [ZFrame] -> IO [ZFrame]
forall a. IORef a -> IO a
readIORef IORef [ZFrame]
msgBodyRef

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Whisper :: Text -> Text -> [ZFrame] -> ZMsg
ZM.Whisper
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name,
              _zmsgMessage :: [ZFrame]
ZM._zmsgMessage = [ZFrame]
msgBody
            }

    parseShoutMessage :: Ptr () -> IO (Maybe ZMsg)
parseShoutMessage Ptr ()
msg_ptr = do
      CString
cfromnode <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      CString
cgroupname <- Ptr () -> IO CString
ZB.zyrePopStrFrame Ptr ()
msg_ptr
      String
fromnode <- CString -> IO String
peekCString CString
cfromnode IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cfromnode
      String
name <- CString -> IO String
peekCString CString
cname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cname
      String
groupname <- CString -> IO String
peekCString CString
cgroupname IO String -> IO () -> IO String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cgroupname

      IORef [ZFrame]
msgBodyRef <- [ZFrame] -> IO (IORef [ZFrame])
forall a. a -> IO (IORef a)
newIORef []
      Ptr () -> IORef [ZFrame] -> IO ()
extractFrames Ptr ()
msg_ptr IORef [ZFrame]
msgBodyRef
      [ZFrame]
msgBody <- IORef [ZFrame] -> IO [ZFrame]
forall a. IORef a -> IO a
readIORef IORef [ZFrame]
msgBodyRef

      Maybe ZMsg -> IO (Maybe ZMsg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ZMsg -> IO (Maybe ZMsg)) -> Maybe ZMsg -> IO (Maybe ZMsg)
forall a b. (a -> b) -> a -> b
$
        ZMsg -> Maybe ZMsg
forall a. a -> Maybe a
Just (ZMsg -> Maybe ZMsg) -> ZMsg -> Maybe ZMsg
forall a b. (a -> b) -> a -> b
$
          Shout :: Text -> Text -> Text -> [ZFrame] -> ZMsg
ZM.Shout
            { _zmsgFromNode :: Text
ZM._zmsgFromNode = String -> Text
T.pack String
fromnode,
              _zmsgName :: Text
ZM._zmsgName = String -> Text
T.pack String
name,
              _zmsgGroupName :: Text
ZM._zmsgGroupName = String -> Text
T.pack String
groupname,
              _zmsgMessage :: [ZFrame]
ZM._zmsgMessage = [ZFrame]
msgBody
            }

-- | List the id of the peers in the peer network.
peers :: ZyreContext ZRunning -> IO [Text]
peers :: ZyreContext ZRunning -> IO [Text]
peers zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) = ZyreContext ZRunning -> IO [Text] -> IO [Text]
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO [Text] -> IO [Text]) -> IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ do
  Ptr ()
list_ptr <- Ptr () -> IO (Ptr ())
ZB.zyrePeers Ptr ()
ptr
  IORef [Text]
returnRef <- [Text] -> IO (IORef [Text])
forall a. a -> IO (IORef a)
newIORef []
  Ptr () -> IORef [Text] -> IO ()
extractList Ptr ()
list_ptr IORef [Text]
returnRef
  Ptr () -> IO ()
ZB.zyreZListDestroy Ptr ()
list_ptr
  IORef [Text] -> IO [Text]
forall a. IORef a -> IO a
readIORef IORef [Text]
returnRef

-- | List the id of the peers in a specific group in the peer network.
peersByGroup :: ZyreContext ZRunning -> Text -> IO (Maybe [Text])
peersByGroup :: ZyreContext ZRunning -> Text -> IO (Maybe [Text])
peersByGroup zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
group = ZyreContext ZRunning -> IO (Maybe [Text]) -> IO (Maybe [Text])
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO (Maybe [Text]) -> IO (Maybe [Text]))
-> IO (Maybe [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
  IORef [Text]
returnRef <- [Text] -> IO (IORef [Text])
forall a. a -> IO (IORef a)
newIORef []
  CString
cgroup <- String -> IO CString
newCString (Text -> String
T.unpack Text
group)
  Ptr ()
list_ptr <- Ptr () -> CString -> IO (Ptr ())
ZB.zyrePeersByGroup Ptr ()
ptr CString
cgroup
  if Ptr ()
list_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ()
forall a. Ptr a
nullPtr
    then do
      Ptr () -> IORef [Text] -> IO ()
extractList Ptr ()
list_ptr IORef [Text]
returnRef
      Ptr () -> IO ()
ZB.zyreZListDestroy Ptr ()
list_ptr
    else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cgroup
  (\[Text]
xs -> if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
xs then Maybe [Text]
forall a. Maybe a
Nothing else [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
xs) ([Text] -> Maybe [Text]) -> IO [Text] -> IO (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef [Text] -> IO [Text]
forall a. IORef a -> IO a
readIORef IORef [Text]
returnRef

-- | Retrieve the endpoint of a connected peer.
-- Returns 'Nothing' if peer does not exist.
peerAddress :: ZyreContext ZRunning -> Text -> IO (Maybe Text)
peerAddress :: ZyreContext ZRunning -> Text -> IO (Maybe Text)
peerAddress zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
peer = ZyreContext ZRunning -> IO (Maybe Text) -> IO (Maybe Text)
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO (Maybe Text) -> IO (Maybe Text))
-> IO (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
  CString
cpeer <- String -> IO CString
newCString (Text -> String
T.unpack Text
peer)
  CString
caddress <- Ptr () -> CString -> IO CString
ZB.zyrePeerAddress Ptr ()
ptr CString
cpeer
  Text
address <- String -> Text
T.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
caddress
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cpeer
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
caddress
  Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
address then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
address

peerName :: ZyreContext ZRunning -> Text -> IO (Maybe Text)
peerName :: ZyreContext ZRunning -> Text -> IO (Maybe Text)
peerName zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
_ IORef Bool
_ IORef (Map Text Text)
nameMap) Text
peer = ZyreContext ZRunning -> IO (Maybe Text) -> IO (Maybe Text)
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO (Maybe Text) -> IO (Maybe Text))
-> IO (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
  Map Text Text
map <- IORef (Map Text Text) -> IO (Map Text Text)
forall a. IORef a -> IO a
readIORef IORef (Map Text Text)
nameMap
  Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
peer Map Text Text
map

-- | Retrieve the value of a header of a connected peer.
-- Returns 'Nothing' if peer or key doesn't exist.
peerHeaderValue :: ZyreContext ZRunning -> Text -> Text -> IO (Maybe Text)
peerHeaderValue :: ZyreContext ZRunning -> Text -> Text -> IO (Maybe Text)
peerHeaderValue zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) Text
peer Text
header = ZyreContext ZRunning -> IO (Maybe Text) -> IO (Maybe Text)
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO (Maybe Text) -> IO (Maybe Text))
-> IO (Maybe Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
  CString
cpeer <- String -> IO CString
newCString (Text -> String
T.unpack Text
peer)
  CString
cheader <- String -> IO CString
newCString (Text -> String
T.unpack Text
header)
  CString
cvalue <- Ptr () -> CString -> CString -> IO CString
ZB.zyrePeerHeaderValue Ptr ()
ptr CString
cpeer CString
cheader
  Text
value <- if CString
cvalue CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr then Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
T.empty else String -> Text
T.pack (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
cvalue
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cpeer
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cheader
  CString -> IO ()
forall a. Ptr a -> IO ()
free CString
cvalue
  Maybe Text -> IO (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Text -> Bool
T.null Text
value then Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
value

-- | List the groups that you are a part of.
ownGroups :: ZyreContext ZRunning -> IO [Text]
ownGroups :: ZyreContext ZRunning -> IO [Text]
ownGroups zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) = ZyreContext ZRunning -> IO [Text] -> IO [Text]
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO [Text] -> IO [Text]) -> IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ do
  Ptr ()
list_ptr <- Ptr () -> IO (Ptr ())
ZB.zyreOwnGroups Ptr ()
ptr
  IORef [Text]
returnRef <- [Text] -> IO (IORef [Text])
forall a. a -> IO (IORef a)
newIORef []
  Ptr () -> IORef [Text] -> IO ()
extractList Ptr ()
list_ptr IORef [Text]
returnRef
  Ptr () -> IO ()
ZB.zyreZListDestroy Ptr ()
list_ptr
  IORef [Text] -> IO [Text]
forall a. IORef a -> IO a
readIORef IORef [Text]
returnRef

-- | List groups that are known through connected peers.
peerGroups :: ZyreContext ZRunning -> IO [Text]
peerGroups :: ZyreContext ZRunning -> IO [Text]
peerGroups zctx :: ZyreContext ZRunning
zctx@(ZyreContext Ptr ()
ptr IORef Bool
_ IORef (Map Text Text)
_) = ZyreContext ZRunning -> IO [Text] -> IO [Text]
forall s a. ZyreContext s -> IO a -> IO a
unlessStale ZyreContext ZRunning
zctx (IO [Text] -> IO [Text]) -> IO [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ do
  Ptr ()
list_ptr <- Ptr () -> IO (Ptr ())
ZB.zyreOwnGroups Ptr ()
ptr
  IORef [Text]
returnRef <- [Text] -> IO (IORef [Text])
forall a. a -> IO (IORef a)
newIORef []
  Ptr () -> IORef [Text] -> IO ()
extractList Ptr ()
list_ptr IORef [Text]
returnRef
  Ptr () -> IO ()
ZB.zyreZListDestroy Ptr ()
list_ptr
  IORef [Text] -> IO [Text]
forall a. IORef a -> IO a
readIORef IORef [Text]
returnRef

-- | Internal helper function.
-- Traverses a zmsg using next() and accumulates the frames in an IORef.
extractFrames :: Ptr () -> IORef [ZM.ZFrame] -> IO ()
extractFrames :: Ptr () -> IORef [ZFrame] -> IO ()
extractFrames Ptr ()
msg_ptr IORef [ZFrame]
framesRef = do
  Ptr ()
cursor <- Ptr () -> IO (Ptr ())
ZB.zyreNextFrame Ptr ()
msg_ptr
  if Ptr ()
cursor Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ()
forall a. Ptr a
nullPtr
    then do
      CInt
len <- Ptr () -> IO CInt
ZB.zyreFrameSize Ptr ()
cursor
      CString
content_ptr <- Ptr () -> IO CString
ZB.zyreFrameData Ptr ()
cursor
      ByteString
packed <- CStringLen -> IO ByteString
BS.packCStringLen (CString
content_ptr, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len)
      IORef [ZFrame] -> ([ZFrame] -> ([ZFrame], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [ZFrame]
framesRef (\[ZFrame]
x -> ([ZFrame]
x [ZFrame] -> [ZFrame] -> [ZFrame]
forall a. Semigroup a => a -> a -> a
<> [ByteString -> ZFrame
ZM.mkFrame ByteString
packed], ()))
      Ptr () -> IORef [ZFrame] -> IO ()
extractFrames Ptr ()
msg_ptr IORef [ZFrame]
framesRef
    else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Internal helper function.
-- Traverses an unpacked zhash table, using next() and cursor() to
-- accumulate the stored values into a dictionary in an IORef.
extractHeaders :: Ptr () -> IORef [(Text, Text)] -> IO ()
extractHeaders :: Ptr () -> IORef [(Text, Text)] -> IO ()
extractHeaders Ptr ()
header_ptr IORef [(Text, Text)]
headersRef = do
  CString
cursor <- Ptr () -> IO CString
ZB.zyreNextHeader Ptr ()
header_ptr
  if CString
cursor CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr
    then do
      CString
key_ptr <- Ptr () -> IO CString
ZB.zyreHeaderCursor Ptr ()
header_ptr
      String
key <- CString -> IO String
peekCString CString
key_ptr
      String
val <- CString -> IO String
peekCString CString
cursor

      IORef [(Text, Text)]
-> ([(Text, Text)] -> ([(Text, Text)], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [(Text, Text)]
headersRef (\[(Text, Text)]
x -> ([(Text, Text)]
x [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(String -> Text
T.pack String
key, String -> Text
T.pack String
val)], ()))
      Ptr () -> IORef [(Text, Text)] -> IO ()
extractHeaders Ptr ()
header_ptr IORef [(Text, Text)]
headersRef
    else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Internal helper function.
-- Extracts values in a zlist as text values into an IORef.
extractList :: Ptr () -> IORef [Text] -> IO ()
extractList :: Ptr () -> IORef [Text] -> IO ()
extractList Ptr ()
list_ptr IORef [Text]
accumRef = do
  CString
cursor <- Ptr () -> IO CString
ZB.zyreZListNext Ptr ()
list_ptr
  if CString
cursor CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr
    then do
      String
val <- CString -> IO String
peekCString CString
cursor
      IORef [Text] -> ([Text] -> ([Text], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [Text]
accumRef (\[Text]
x -> ([Text]
x [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [String -> Text
T.pack String
val], ()))
      Ptr () -> IORef [Text] -> IO ()
extractList Ptr ()
list_ptr IORef [Text]
accumRef
    else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()