{-# LANGUAGE OverloadedStrings #-}

-- | Message types for sending and receiving from a Zyre peer network.
module Network.Zyre2.ZMsg
  ( ZMsg (..),
    ZFrame,
    pop,
    pushText,
    addText,
    popText,
    pushMem,
    addMem,
    popMem,
    mkFrame,
    frameData,
    msgWhisper,
    msgShout,
  )
where

import Control.Exception (throw)
import qualified Data.Bifunctor
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BSC
import qualified Data.List as List
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
import Network.Zyre2.Types (ZyreException (ZyreMsgDontSupportFramesException))

-- | Message-types supported and published by zyre.
data ZMsg
  = -- | A peer has joined the peer network.
    Enter
      { -- | The UUID of the sending node.
        ZMsg -> Text
_zmsgFromNode :: Text,
        -- | The name of the sending node.
        ZMsg -> Text
_zmsgName :: Text,
        -- | Dictionary containing the headers.
        ZMsg -> [(Text, Text)]
_zmsgHeaders :: [(Text, Text)],
        -- | The ip and port of the sending node. E.g. tcp://127.0.0.1:8344
        ZMsg -> Text
_zmsgIpPort :: Text
      }
  | -- | A peer has not sent a message within the 'evasive' interval period.
    -- The peer will be pinged.
    Evasive
      { _zmsgFromNode :: Text,
        _zmsgName :: Text
      }
  | -- | A peer has been silent and not responded to PING messages for the 'silent' interval period.
    Silent
      { _zmsgFromNode :: Text,
        _zmsgName :: Text
      }
  | -- | A peer has exited the peer network.
    Exit
      { _zmsgFromNode :: Text,
        _zmsgName :: Text
      }
  | -- | A peer has joined a group.
    Join
      { _zmsgFromNode :: Text,
        _zmsgName :: Text,
        ZMsg -> Text
_zmsgGroupName :: Text
      }
  | -- | A peer has left a group.
    Leave
      { _zmsgFromNode :: Text,
        _zmsgName :: Text,
        -- | The name of the group which the message concerns.
        _zmsgGroupName :: Text
      }
  | -- | A peer has whispered to this node.
    Whisper
      { _zmsgFromNode :: Text,
        _zmsgName :: Text,
        -- | The message content, coded as 'ZFrame's. A message may hold 0 or more frames.
        -- Note: a ZMsg with 0 frames supplied to 'Network.Zyre2.shout' or 'Network.Zyre2.whisper' will be ignored and not sent.
        ZMsg -> [ZFrame]
_zmsgMessage :: [ZFrame]
      }
  | -- | A peer has shouted in a group.
    Shout
      { _zmsgFromNode :: Text,
        _zmsgName :: Text,
        _zmsgGroupName :: Text,
        _zmsgMessage :: [ZFrame]
      }
  | -- | The zyre context which is being listened to has been stopped.
    Stop
  deriving (Int -> ZMsg -> ShowS
[ZMsg] -> ShowS
ZMsg -> String
(Int -> ZMsg -> ShowS)
-> (ZMsg -> String) -> ([ZMsg] -> ShowS) -> Show ZMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZMsg] -> ShowS
$cshowList :: [ZMsg] -> ShowS
show :: ZMsg -> String
$cshow :: ZMsg -> String
showsPrec :: Int -> ZMsg -> ShowS
$cshowsPrec :: Int -> ZMsg -> ShowS
Show)

-- | A frame of binary data. See 'Network.Zyre2.ZMsg.mkFrame' and 'Network.Zyre2.ZMsg.frameData'.
newtype ZFrame = ZFrame ByteString

instance Show ZFrame where
  show :: ZFrame -> String
show (ZFrame ByteString
_) = String
"ZFrame[Bytes]"

{- Utility functions -}

pushFrame :: ZMsg -> ZFrame -> ZMsg
pushFrame :: ZMsg -> ZFrame -> ZMsg
pushFrame zmsg :: ZMsg
zmsg@Whisper {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZFrame
zframe ZFrame -> [ZFrame] -> [ZFrame]
forall a. a -> [a] -> [a]
: ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg}
pushFrame zmsg :: ZMsg
zmsg@Shout {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZFrame
zframe ZFrame -> [ZFrame] -> [ZFrame]
forall a. a -> [a] -> [a]
: ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg}
pushFrame ZMsg
_ ZFrame
_ = ZyreException -> ZMsg
forall a e. Exception e => e -> a
throw ZyreException
ZyreMsgDontSupportFramesException

addFrame :: ZMsg -> ZFrame -> ZMsg
addFrame :: ZMsg -> ZFrame -> ZMsg
addFrame zmsg :: ZMsg
zmsg@Whisper {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg [ZFrame] -> [ZFrame] -> [ZFrame]
forall a. Semigroup a => a -> a -> a
<> [ZFrame
zframe]}
addFrame zmsg :: ZMsg
zmsg@Shout {} ZFrame
zframe = ZMsg
zmsg {_zmsgMessage :: [ZFrame]
_zmsgMessage = ZMsg -> [ZFrame]
_zmsgMessage ZMsg
zmsg [ZFrame] -> [ZFrame] -> [ZFrame]
forall a. Semigroup a => a -> a -> a
<> [ZFrame
zframe]}
addFrame ZMsg
_ ZFrame
_ = ZyreException -> ZMsg
forall a e. Exception e => e -> a
throw ZyreException
ZyreMsgDontSupportFramesException

-- {- Interface -}

append :: ZMsg -> ZFrame -> ZMsg
append :: ZMsg -> ZFrame -> ZMsg
append = ZMsg -> ZFrame -> ZMsg
addFrame

prepend :: ZMsg -> ZFrame -> ZMsg
prepend :: ZMsg -> ZFrame -> ZMsg
prepend = ZMsg -> ZFrame -> ZMsg
pushFrame

-- | Remove the first frame of a ZMsg, or return 'Nothing'.
pop :: ZMsg -> (Maybe ZFrame, ZMsg)
pop :: ZMsg -> (Maybe ZFrame, ZMsg)
pop zmsg :: ZMsg
zmsg@Whisper {} = ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg ZMsg
zmsg
pop zmsg :: ZMsg
zmsg@Shout {} = ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg ZMsg
zmsg
pop ZMsg
_ = ZyreException -> (Maybe ZFrame, ZMsg)
forall a e. Exception e => e -> a
throw ZyreException
ZyreMsgDontSupportFramesException

_popMsg :: ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg :: ZMsg -> (Maybe ZFrame, ZMsg)
_popMsg ZMsg
m = case ZMsg -> [ZFrame]
_zmsgMessage ZMsg
m of
  [] -> (Maybe ZFrame
forall a. Maybe a
Nothing, ZMsg
m)
  [ZFrame
x] -> (ZFrame -> Maybe ZFrame
forall a. a -> Maybe a
Just ZFrame
x, ZMsg
m {_zmsgMessage :: [ZFrame]
_zmsgMessage = []})
  (ZFrame
x : [ZFrame]
_) -> (ZFrame -> Maybe ZFrame
forall a. a -> Maybe a
Just ZFrame
x, ZMsg
m {_zmsgMessage :: [ZFrame]
_zmsgMessage = [ZFrame] -> [ZFrame]
forall a. [a] -> [a]
List.tail (ZMsg -> [ZFrame]
_zmsgMessage ZMsg
m)})

-- | Push a text frame to the front of a 'ZMsg'.
pushText :: Text -> ZMsg -> ZMsg
pushText :: Text -> ZMsg -> ZMsg
pushText Text
str ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`pushFrame` ByteString -> ZFrame
ZFrame (String -> ByteString
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
str))

-- | Add a text frame to the end of a 'ZMsg'.
addText :: Text -> ZMsg -> ZMsg
addText :: Text -> ZMsg -> ZMsg
addText Text
str ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`addFrame` ByteString -> ZFrame
ZFrame (String -> ByteString
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
str))

-- | Push binary data to the front of a 'ZMsg' as a frame.
pushMem :: ByteString -> ZMsg -> ZMsg
pushMem :: ByteString -> ZMsg -> ZMsg
pushMem ByteString
bs ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`pushFrame` ByteString -> ZFrame
ZFrame ByteString
bs

-- | Add binary data to the end of a 'ZMsg' as a frame.
addMem :: ByteString -> ZMsg -> ZMsg
addMem :: ByteString -> ZMsg -> ZMsg
addMem ByteString
bs ZMsg
zmsg = ZMsg
zmsg ZMsg -> ZFrame -> ZMsg
`addFrame` ByteString -> ZFrame
ZFrame ByteString
bs

-- | Remove the first frame of the 'ZMsg', and interpret it as 'Text'.
popText :: ZMsg -> (Maybe Text, ZMsg)
popText :: ZMsg -> (Maybe Text, ZMsg)
popText ZMsg
zmsg =
  (Maybe ZFrame -> Maybe Text)
-> (Maybe ZFrame, ZMsg) -> (Maybe Text, ZMsg)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
    ((ZFrame -> Text) -> Maybe ZFrame -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ZFrame ByteString
bs) -> String -> Text
T.pack (ByteString -> String
BSC.unpack ByteString
bs)))
    (ZMsg -> (Maybe ZFrame, ZMsg)
pop ZMsg
zmsg)

-- | Remove the first frame of the 'ZMsg' as a 'ByteString'.
popMem :: ZMsg -> (Maybe ByteString, ZMsg)
popMem :: ZMsg -> (Maybe ByteString, ZMsg)
popMem ZMsg
zmsg =
  (Maybe ZFrame -> Maybe ByteString)
-> (Maybe ZFrame, ZMsg) -> (Maybe ByteString, ZMsg)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Data.Bifunctor.first
    ((ZFrame -> ByteString) -> Maybe ZFrame -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ZFrame ByteString
bs) -> ByteString
bs))
    (ZMsg -> (Maybe ZFrame, ZMsg)
pop ZMsg
zmsg)

-- | Create a frame from a ByteString.
mkFrame :: ByteString -> ZFrame
mkFrame :: ByteString -> ZFrame
mkFrame = ByteString -> ZFrame
ZFrame

-- | Retrieve the data stored in a 'ZFrame'.
frameData :: ZFrame -> ByteString
frameData :: ZFrame -> ByteString
frameData (ZFrame ByteString
bs) = ByteString
bs

-- | Empty 'Whisper' message. Combine with 'addText', 'pushText',
-- 'addMem', and 'pushMem' to construct a whisper to send.
msgWhisper :: ZMsg
msgWhisper :: ZMsg
msgWhisper =
  Whisper :: Text -> Text -> [ZFrame] -> ZMsg
Whisper
    { _zmsgFromNode :: Text
_zmsgFromNode = Text
"Not set",
      _zmsgName :: Text
_zmsgName = Text
"Not set",
      _zmsgMessage :: [ZFrame]
_zmsgMessage = []
    }

-- | Empty 'Shout' message. Combine with 'addText', 'pushText',
-- 'addMem', and 'pushMem' to construct a shout to send.
msgShout :: ZMsg
msgShout :: ZMsg
msgShout =
  Shout :: Text -> Text -> Text -> [ZFrame] -> ZMsg
Shout
    { _zmsgFromNode :: Text
_zmsgFromNode = Text
"Not set",
      _zmsgName :: Text
_zmsgName = Text
"Not set",
      _zmsgGroupName :: Text
_zmsgGroupName = Text
"Not set",
      _zmsgMessage :: [ZFrame]
_zmsgMessage = []
    }