ZMsg.hs

{-# 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.
        _zmsgFromNode :: Text,
        -- | The name of the sending node.
        _zmsgName :: Text,
        -- | Dictionary containing the headers.
        _zmsgHeaders :: [(Text, Text)],
        -- | The ip and port of the sending node. E.g. tcp://127.0.0.1:8344
        _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,
        _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.
        _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 (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 _) = "ZFrame[Bytes]"

{- Utility functions -}

pushFrame :: ZMsg -> ZFrame -> ZMsg
pushFrame zmsg@Whisper {} zframe = zmsg {_zmsgMessage = zframe : _zmsgMessage zmsg}
pushFrame zmsg@Shout {} zframe = zmsg {_zmsgMessage = zframe : _zmsgMessage zmsg}
pushFrame _ _ = throw ZyreMsgDontSupportFramesException

addFrame :: ZMsg -> ZFrame -> ZMsg
addFrame zmsg@Whisper {} zframe = zmsg {_zmsgMessage = _zmsgMessage zmsg <> [zframe]}
addFrame zmsg@Shout {} zframe = zmsg {_zmsgMessage = _zmsgMessage zmsg <> [zframe]}
addFrame _ _ = throw ZyreMsgDontSupportFramesException

-- {- Interface -}

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

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

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

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

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

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

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

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

-- | Remove the first frame of the 'ZMsg', and interpret it as 'Text'.
popText :: ZMsg -> (Maybe Text, ZMsg)
popText zmsg =
  Data.Bifunctor.first
    (fmap (\(ZFrame bs) -> T.pack (BSC.unpack bs)))
    (pop zmsg)

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

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

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

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

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