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
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 :: 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 :: 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 :: 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 :: 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 :: 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
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
version :: IO Word64
version :: IO Word64
version = IO Word64
ZB.zyreVersion
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 :: 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)
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 :: 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)
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
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
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
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
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
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
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
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
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
Ptr () -> IO ()
ZB.zyreDestroyFrame Ptr ()
cheader_ptr
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
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
}
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
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
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
peerHeaderValue :: ZyreContext ZRunning -> Text -> Text -> IO (Maybe Text)
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
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
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
extractFrames :: Ptr () -> IORef [ZM.ZFrame] -> IO ()
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 ()
extractHeaders :: Ptr () -> IORef [(Text, Text)] -> IO ()
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 ()
extractList :: Ptr () -> IORef [Text] -> IO ()
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 ()