-------------------------------------------------------------------------------
-- |
-- Module     : Network/Mom/Stompl/Frame.hs
-- Copyright  : (c) Tobias Schoofs
-- License    : LGPL
-- Stability  : experimental
-- Portability: portable
--
-- Stomp Frames and some useful operations on them
-------------------------------------------------------------------------------
module Network.Mom.Stompl.Frame (
                       -- * Frames
                       -- $stomp_frames
                       Frame, FrameType(..),
                       Header, Body, Heart, Version,
                       AckMode(..), isValidAck, 
                       SrvDesc,
                       getSrvName, getSrvVer, getSrvCmts,
                       -- * Frame Constructors
                       -- $stomp_constructors

                       -- ** Basic Frame Constructors
                       mkConnect, mkStomp, mkConnected, 
                       mkSubscribe, mkUnsubscribe, 
                       mkSend, mkMessage, mkErr,
                       mkBegin, mkCommit,  mkAbort,
                       mkAck, mkNack, 
                       mkDisconnect,  
                       mkBeat, mkReceipt,
                       -- ** Header-based Frame Constructors
                       mkConFrame, mkStmpFrame, mkCondFrame, mkDisFrame,
                       mkSubFrame, mkUSubFrame, 
                       mkSndFrame, mkMsgFrame, mkErrFrame,
                       mkBgnFrame, mkCmtFrame,  mkAbrtFrame,
                       mkAckFrame, mkNackFrame, mkRecFrame,
                       -- * Working with Headers
                       -- $stomp_headers
                       mkLogHdr,   mkPassHdr, mkDestHdr, 
                       mkLenHdr,   mkTrnHdr,  mkRecHdr, 
                       mkSelHdr,   mkIdHdr,   mkAckHdr, 
                       mkSesHdr,   mkMsgHdr,  mkMIdHdr,
                       mkAcVerHdr, mkVerHdr,  mkHostHdr,
                       mkBeatHdr,  mkMimeHdr, mkSrvHdr,
                       mkSubHdr, mkCliIdHdr,
                       valToVer, valToVers, verToVal, versToVal,
                       beatToVal, valToBeat,
                       ackToVal, valToAck,
                       strToSrv, srvToStr,
                       negoVersion, negoBeat,
                       rmHdr, rmHdrs, 
                       getAck, getLen,   
                       -- * Working with Frames
                       typeOf, putFrame, toString, putCommand,
                       sndToMsg, conToCond,
                       resetTrans, 
                       complies,
                       -- * Get Access to Frames
                       getDest, getTrans, getReceipt,
                       getLogin, getPasscode, getCliId,
                       getHost, getVersions, getVersion,
                       getBeat, 
                       getSession, getServer, 
                       getSub, getSelector, getId, getAcknow, getMsgAck,
                       getBody, getMime, getLength, 
                       getMsg, getHeaders,
                       -- * Sequence Operators to work on 'ByteString'
                       (|>), (<|), (>|<),
                       -- * Some random helpers 
                       --   (that do not really belong here)
                       upString, numeric)
where

  -- Todo:
  -- - conformance to protocol

  import qualified Data.ByteString       as B
  import qualified Data.ByteString.UTF8  as U
  import           Data.Char (toUpper, isDigit)
  import           Data.Word8 (Word8)
  import           Data.List (find, sortBy, foldl', nub)
  import           Data.List.Split (splitWhen)
  import           Data.Maybe (catMaybes, fromMaybe)
  import qualified Codec.MIME.Type as Mime (showType, Type, nullType)
  import qualified Codec.MIME.Parse as MP  (parseMIMEType)
  import qualified Data.Text as T

  ------------------------------------------------------------------------
  -- | Tuple of (key, value)
  ------------------------------------------------------------------------
  type Header = (String, String)

  ------------------------------------------------------------------------
  -- | The Frame body is represented as /strict/ 'ByteString'.
  ------------------------------------------------------------------------
  type Body   = B.ByteString

  ------------------------------------------------------------------------
  -- | The Stomp version used or accepted by the sender;
  --   the first 'Int' is the major version number,
  --   the second is the minor.
  --   For details on version negotiation, please refer to 
  --   the Stomp specification.
  ------------------------------------------------------------------------
  type Version = (Int, Int)
  
  ------------------------------------------------------------------------
  -- | Heart-beat configuration;
  --   the first 'Int' of the pair represents the frequency 
  --   in which the sender wants to send heart-beats; 
  --   the second represents the highest frequency
  --   in which the sender can accept heart-beats.
  --   The frequency is expressed as 
  --   the period in milliseconds between two heart-beats.
  --   For details on negotiating heart-beats, 
  --   please refer to the Stomp specification.
  ------------------------------------------------------------------------
  type Heart   = (Int, Int)

  -------------------------------------------------------------------------
  -- | Description of a server consisting of
  --   name, version and comments
  -------------------------------------------------------------------------
  type SrvDesc = (String, String, String)

  -------------------------------------------------------------------------
  -- | get name from 'SrvDesc'
  -------------------------------------------------------------------------
  getSrvName :: SrvDesc -> String
  getSrvName :: SrvDesc -> String
getSrvName (String
n, String
_, String
_) = String
n

  -------------------------------------------------------------------------
  -- | get version from 'SrvDesc'
  -------------------------------------------------------------------------
  getSrvVer :: SrvDesc -> String
  getSrvVer :: SrvDesc -> String
getSrvVer  (String
_, String
v, String
_) = String
v

  -------------------------------------------------------------------------
  -- | get comments from 'SrvDesc'
  -------------------------------------------------------------------------
  getSrvCmts :: SrvDesc -> String
  getSrvCmts :: SrvDesc -> String
getSrvCmts (String
_, String
_, String
c) = String
c

  noBeat :: Heart
  noBeat :: Heart
noBeat = (Int
0,Int
0)

  -------------------------------------------------------------------------
  -- Convert MIME Type
  -------------------------------------------------------------------------
  showType :: Mime.Type -> String
  showType :: Type -> String
showType = Text -> String
T.unpack (Text -> String) -> (Type -> Text) -> Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Text
Mime.showType

  parseMIMEType :: String -> Maybe Mime.Type
  parseMIMEType :: String -> Maybe Type
parseMIMEType = Text -> Maybe Type
MP.parseMIMEType (Text -> Maybe Type) -> (String -> Text) -> String -> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

  defMime :: Mime.Type
  defMime :: Type
defMime =  Type
Mime.nullType

  defVerStr :: String
  defVerStr :: String
defVerStr = String
"1.0"

  defVersion :: Version
  defVersion :: Heart
defVersion = (Int
1, Int
0)

  noSrvDesc :: SrvDesc
  noSrvDesc :: SrvDesc
noSrvDesc = (String
"",String
"",String
"")

  hdrLog, hdrPass, hdrDest, hdrSub, hdrLen, hdrTrn, hdrRec, hdrRecId,
    hdrSel, hdrId, hdrAck, hdrAckId, hdrSes, hdrMsg, hdrMId, hdrSrv,
    hdrAcVer, hdrVer, hdrBeat, hdrHost, hdrMime, hdrCliId :: String
  hdrLog :: String
hdrLog   = String
"login"
  hdrPass :: String
hdrPass  = String
"passcode"
  hdrCliId :: String
hdrCliId = String
"client-id"
  hdrDest :: String
hdrDest  = String
"destination"
  hdrSub :: String
hdrSub   = String
"subscription"
  hdrLen :: String
hdrLen   = String
"content-length"
  hdrMime :: String
hdrMime  = String
"content-type"
  hdrTrn :: String
hdrTrn   = String
"transaction"
  hdrRec :: String
hdrRec   = String
"receipt"
  hdrRecId :: String
hdrRecId = String
"receipt-id"
  hdrSel :: String
hdrSel   = String
"selector"
  hdrId :: String
hdrId    = String
"id"
  hdrAck :: String
hdrAck   = String
"ack"
  hdrAckId :: String
hdrAckId = String
"ack"
  hdrSes :: String
hdrSes   = String
"session-id"
  hdrMsg :: String
hdrMsg   = String
"message"
  hdrMId :: String
hdrMId   = String
"message-id"
  hdrAcVer :: String
hdrAcVer = String
"accept-version"
  hdrVer :: String
hdrVer   = String
"version"
  hdrHost :: String
hdrHost  = String
"host"
  hdrBeat :: String
hdrBeat  = String
"heart-beat"
  hdrSrv :: String
hdrSrv   = String
"server"

  mkHeader :: String -> String -> Header
  mkHeader :: String -> String -> Header
mkHeader String
k String
v = (String
k, String
v)

  ------------------------------------------------------------------------
  -- | make /login/ header
  ------------------------------------------------------------------------
  mkLogHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /passcode/ header
  ------------------------------------------------------------------------
  mkPassHdr  :: String -> Header
  ------------------------------------------------------------------------
  -- | make /client-id/ header
  ------------------------------------------------------------------------
  mkCliIdHdr  :: String -> Header
  ------------------------------------------------------------------------
  -- | make /destination/ header
  ------------------------------------------------------------------------
  mkDestHdr  :: String -> Header
  ------------------------------------------------------------------------
  -- | make /content-length/ header
  ------------------------------------------------------------------------
  mkLenHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /content-type/ header
  ------------------------------------------------------------------------
  mkMimeHdr  :: String -> Header
  ------------------------------------------------------------------------
  -- | make /transaction/ header
  ------------------------------------------------------------------------
  mkTrnHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /receipt/ header
  ------------------------------------------------------------------------
  mkRecHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /receipt-id/ header
  ------------------------------------------------------------------------
  mkRecIdHdr :: String -> Header
  ------------------------------------------------------------------------
  -- | make /selector/ header
  ------------------------------------------------------------------------
  mkSelHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /message-id/ header
  ------------------------------------------------------------------------
  mkMIdHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /id/ header (subscribe frame)
  ------------------------------------------------------------------------
  mkIdHdr    :: String -> Header
  ------------------------------------------------------------------------
  -- | make /subscription/ header
  ------------------------------------------------------------------------
  mkSubHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /server/ header (connected frame)
  ------------------------------------------------------------------------
  mkSrvHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /ack/ header (subscribe frame)
  ------------------------------------------------------------------------
  mkAckHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /session/ header (connected frame)
  ------------------------------------------------------------------------
  mkSesHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /accept-version/ header (connect frame)
  ------------------------------------------------------------------------
  mkAcVerHdr :: String -> Header
  ------------------------------------------------------------------------
  -- | make /version/ header (connected frame)
  ------------------------------------------------------------------------
  mkVerHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /host/ header (connect frame)
  ------------------------------------------------------------------------
  mkHostHdr  :: String -> Header
  ------------------------------------------------------------------------
  -- | make /message/ header (error frame)
  ------------------------------------------------------------------------
  mkMsgHdr   :: String -> Header
  ------------------------------------------------------------------------
  -- | make /heart-beat/ header
  ------------------------------------------------------------------------
  mkBeatHdr  :: String -> Header

  mkLogHdr :: String -> Header
mkLogHdr   = String -> String -> Header
mkHeader String
hdrLog
  mkPassHdr :: String -> Header
mkPassHdr  = String -> String -> Header
mkHeader String
hdrPass
  mkCliIdHdr :: String -> Header
mkCliIdHdr = String -> String -> Header
mkHeader String
hdrCliId
  mkDestHdr :: String -> Header
mkDestHdr  = String -> String -> Header
mkHeader String
hdrDest
  mkLenHdr :: String -> Header
mkLenHdr   = String -> String -> Header
mkHeader String
hdrLen
  mkMimeHdr :: String -> Header
mkMimeHdr  = String -> String -> Header
mkHeader String
hdrMime
  mkTrnHdr :: String -> Header
mkTrnHdr   = String -> String -> Header
mkHeader String
hdrTrn
  mkRecHdr :: String -> Header
mkRecHdr   = String -> String -> Header
mkHeader String
hdrRec
  mkRecIdHdr :: String -> Header
mkRecIdHdr = String -> String -> Header
mkHeader String
hdrRecId
  mkSelHdr :: String -> Header
mkSelHdr   = String -> String -> Header
mkHeader String
hdrSel
  mkIdHdr :: String -> Header
mkIdHdr    = String -> String -> Header
mkHeader String
hdrId
  mkMIdHdr :: String -> Header
mkMIdHdr   = String -> String -> Header
mkHeader String
hdrMId
  mkAckHdr :: String -> Header
mkAckHdr   = String -> String -> Header
mkHeader String
hdrAck
  mkSubHdr :: String -> Header
mkSubHdr   = String -> String -> Header
mkHeader String
hdrSub
  mkSesHdr :: String -> Header
mkSesHdr   = String -> String -> Header
mkHeader String
hdrSes
  mkMsgHdr :: String -> Header
mkMsgHdr   = String -> String -> Header
mkHeader String
hdrMsg
  mkVerHdr :: String -> Header
mkVerHdr   = String -> String -> Header
mkHeader String
hdrVer
  mkAcVerHdr :: String -> Header
mkAcVerHdr = String -> String -> Header
mkHeader String
hdrAcVer
  mkHostHdr :: String -> Header
mkHostHdr  = String -> String -> Header
mkHeader String
hdrHost
  mkBeatHdr :: String -> Header
mkBeatHdr  = String -> String -> Header
mkHeader String
hdrBeat
  mkSrvHdr :: String -> Header
mkSrvHdr   = String -> String -> Header
mkHeader String
hdrSrv

  {- $stomp_frames
     Frames are the building blocks of the Stomp protocol.
     They are exchanged between broker and application 
     and contain commands or status and error messages.

     Frames follow a simple text-based format.
     They consist of a /command/ (the 'FrameType'),
     a list of key\/value-pairs, called 'Header',
     and a 'Body' (which is empty for most frame types).
  -}

  -------------------------------------------------------------------------
  -- | This is a frame
  -------------------------------------------------------------------------
  data Frame = ConFrame {
                   Frame -> String
frmLogin :: String,
                   Frame -> String
frmPass  :: String,
                   Frame -> String
frmHost  :: String,
                   Frame -> Heart
frmBeat  :: Heart,
                   Frame -> [Heart]
frmAcVer :: [Version], -- 1.2
                   Frame -> String
frmCliId :: String,
                   Frame -> [Header]
frmHdrs  :: [Header]
                 }
               | StompFrame {
                   frmLogin :: String,
                   frmPass  :: String,
                   frmHost  :: String,
                   frmBeat  :: Heart,
                   frmAcVer :: [Version], -- 1.2
                   frmCliId :: String,
                   frmHdrs  :: [Header]
                 }
               | CondFrame {
                   Frame -> String
frmSes   :: String,
                   frmBeat  :: Heart,
                   Frame -> Heart
frmVer   :: Version, -- 1.2
                   Frame -> SrvDesc
frmSrv   :: SrvDesc,
                   frmHdrs  :: [Header]
                 }
               | SubFrame {
                   Frame -> String
frmDest  :: String,
                   Frame -> AckMode
frmAck   :: AckMode,
                   Frame -> String
frmSel   :: String,
                   Frame -> String
frmId    :: String,
                   Frame -> String
frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | USubFrame {
                   frmDest  :: String,
                   frmId    :: String,
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | SndFrame {
                   frmHdrs  :: [Header],
                   frmDest  :: String,
                   Frame -> String
frmTrans :: String,
                   frmRec   :: String,
                   Frame -> Int
frmLen   :: Int,
                   Frame -> Type
frmMime  :: Mime.Type,
                   Frame -> Body
frmBody  :: Body}
               | DisFrame {
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | BgnFrame {
                   frmTrans :: String,
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | CmtFrame {
                   frmTrans :: String,
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | AckFrame {
                   frmId    :: String,
                   Frame -> String
frmSub   :: String,
                   frmTrans :: String,
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | NackFrame {
                   frmId    :: String,
                   frmSub   :: String,
                   frmTrans :: String,
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | AbrtFrame {
                   frmTrans :: String,
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | MsgFrame {
                   frmHdrs  :: [Header],
                   frmSub   :: String,
                   frmDest  :: String,
                   frmId    :: String,
                   Frame -> String
frmAckId :: String,
                   frmLen   :: Int,
                   frmMime  :: Mime.Type,
                   frmBody  :: Body}
               | RecFrame {
                   frmRec   :: String,
                   frmHdrs  :: [Header]
                 }
               | ErrFrame {
                   Frame -> String
frmMsg  :: String,
                   frmRec  :: String,
                   frmLen  :: Int,
                   frmMime :: Mime.Type,
                   frmHdrs :: [Header],
                   frmBody :: Body}
               | BeatFrame
    deriving (Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show, Frame -> Frame -> Bool
(Frame -> Frame -> Bool) -> (Frame -> Frame -> Bool) -> Eq Frame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frame -> Frame -> Bool
$c/= :: Frame -> Frame -> Bool
== :: Frame -> Frame -> Bool
$c== :: Frame -> Frame -> Bool
Eq)

  {- $stomp_constructors
     There are two different interfaces to construct frames:
     
     * a set of conventional, /basic/ constructors and

     * a set of header-based constructors 

     The /basic/ constructors receive the frame attributes
     directly, /i.e./ with the types, in which they will be stored.
     These constructors are, hence, type-safe.
     They are, however, unsafe in terms of protocol compliance.
     Headers that identify some entity are stored as plain strings. 
     The basic constructors do not verify 
     if an identifier is required for a given frame type.
     Using plain strings for identifiers
     may appear to be odd on the first sight.
     Since this library is intended for any
     implementation of Stomp programs (brokers and applications) where
     identifers (for messages, transactions, receipts, /etc./)
     may have completely different formats,
     no choice was made on dedicated identifier types.

     Header-based constructors, on the other hand, 
     receive attributes packed in a list of 'Header'.
     The types are converted by the constructor. 
     The constructor, additionally, verfies the protocol compliance.
     Header-based constructors are, hence, more reliable.
     This implies, however, that they can fail.
     For this reason, Header-based constructors return 'Either'. 
  -}

  ----------------------------------------------------------------------
  -- | make a 'Connect' frame (Application -> Broker).
  --   The parameters are:
  --
  --   * User: user to authenticate at the broker.
  --
  --   * Passcode: password to authenticate at the broker.
  --
  --   * Host: broker's virtual hoast (/e.g./ 
  --           stomp.broker.github.org).
  --
  --   * 'HeartBeat': the clients bid in negotiating
  --                  the heart-beat.
  --
  --   * 'Version': the versions supported by the client.
  --
  --   * ClientId: Client identification for persistent connections.
  --                 Note that the client id is not a standard Stomp feature,
  --                 but specific to ActiveMQ and other brokers.
  --                
  --
  --   * 'Header': List of additional, broker-specific headers
  ----------------------------------------------------------------------
  mkConnect :: String -> String -> String -> 
               Heart -> [Version] -> String -> [Header] -> Frame
  mkConnect :: String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mkConnect = (String
 -> String
 -> String
 -> Heart
 -> [Heart]
 -> String
 -> [Header]
 -> Frame)
-> String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mkConStmp String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
ConFrame 

  ----------------------------------------------------------------------
  -- | Same as 'mkConnect', but the result is a \"STOMP\" frame
  --   rather than a \"CONNECT\" frame
  ----------------------------------------------------------------------
  mkStomp :: String -> String -> String -> 
               Heart -> [Version] -> String -> [Header] -> Frame
  mkStomp :: String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mkStomp = (String
 -> String
 -> String
 -> Heart
 -> [Heart]
 -> String
 -> [Header]
 -> Frame)
-> String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mkConStmp String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
StompFrame 

  mkConStmp :: (String -> String -> String -> 
                Heart -> [Version] -> String -> [Header] -> Frame) ->
               String -> String -> String -> 
               Heart -> [Version] -> String -> [Header] -> Frame
  mkConStmp :: (String
 -> String
 -> String
 -> Heart
 -> [Heart]
 -> String
 -> [Header]
 -> Frame)
-> String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mkConStmp String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mk String
usr String
pwd String
hst Heart
beat [Heart]
vers String
cli [Header]
hs =
    String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mk String
usr String
pwd String
hst Heart
beat [Heart]
vers String
cli [Header]
hs 
    {-
    mk {
       frmLogin = usr,
       frmPass  = pwd,
       frmHost  = hst,
       frmBeat  = beat,
       frmAcVer = vers,
       frmHdrs  = hs,
       frmCliId = cli}
    -}

  ----------------------------------------------------------------------
  -- | make a 'Connect' frame (Broker -> Application).
  --   The parameters are:
  --
  --   * Session: A unique identifier created by the broker
  --              and identifying the session
  --
  --   * 'HeartBeat': The heart-beat agreed by the broker
  --
  --   * 'Version': The version accepted by the broker
  --
  --   * 'SrvDesc': The server description
  --
  --   * 'Header': List of additional, broker-specific headers.
  ----------------------------------------------------------------------
  mkConnected :: String -> Heart -> Version -> SrvDesc -> [Header] -> Frame
  mkConnected :: String -> Heart -> Heart -> SrvDesc -> [Header] -> Frame
mkConnected String
ses Heart
beat Heart
ver SrvDesc
srv [Header]
hs =
    CondFrame :: String -> Heart -> Heart -> SrvDesc -> [Header] -> Frame
CondFrame {
      frmSes :: String
frmSes  = String
ses,
      frmBeat :: Heart
frmBeat = Heart
beat,
      frmVer :: Heart
frmVer  = Heart
ver, 
      frmSrv :: SrvDesc
frmSrv  = SrvDesc
srv,
      frmHdrs :: [Header]
frmHdrs = [Header]
hs}

  ----------------------------------------------------------------------
  -- | make a 'Subscribe' frame (Application -> Broker).
  --   The parameters are:
  --   
  --   * Destination: The name of the queue as it is known by the broker
  --                  and other applications using the queue
  --   
  --   * 'AckMode': The Acknowledge Mode for this subscription
  --   
  --   * Selector: An expression defining those messages
  --               that are of actual for client.
  --               The Stomp protocol does not define
  --               a language for selectors;
  --               it is even not entirely clear,
  --               where messages are selected:
  --               already at the broker, or only by the client.
  --               Some brokers provide pre-selection of messages, 
  --               others do not.  
  --   
  --   * Subscription Id: A unique identifier distinguishing this 
  --                      subscription from others to the same queue.
  --                      The identifier is defined by the application.
  --   
  --   * Receipt: A unique identifier defined by the application
  --              to request confirmation of receipt of this frame.
  --              If no receipt is wanted, the string shall be empty.
  --
  --   * 'Header': List of additional, broker-specific headers.
  ----------------------------------------------------------------------
  mkSubscribe :: String -> AckMode -> 
                 String -> String  -> String -> [Header] -> Frame
  mkSubscribe :: String
-> AckMode -> String -> String -> String -> [Header] -> Frame
mkSubscribe String
dst AckMode
ack String
sel String
sid String
rc [Header]
hs =
    SubFrame :: String
-> AckMode -> String -> String -> String -> [Header] -> Frame
SubFrame {
      frmDest :: String
frmDest = String
dst,
      frmAck :: AckMode
frmAck  = AckMode
ack,
      frmSel :: String
frmSel  = String
sel,
      frmId :: String
frmId   = String
sid,
      frmRec :: String
frmRec  = String
rc,
      frmHdrs :: [Header]
frmHdrs = [Header]
hs}

  ----------------------------------------------------------------------
  -- | make an 'Unsubscribe' frame (Application -> Broker).
  --   The parameters are:
  -- 
  --   * Destination: The queue name; either a destination or a 
  --                  subscription id must be given. 
  --                  (According to protocol version 1.1,
  --                   the subscription id is mandatory on
  --                   both, 'Subscribe' and 'Unsubscribe'.)
  -- 
  --   * Subscription Id: The subscription identifier (see 'mkSubscribe')
  -- 
  --   * Receipt: The receipt (see 'mkSubscribe')
  --
  --   * 'Header': Additional, broker-specific headers
  ----------------------------------------------------------------------
  mkUnsubscribe :: String -> String -> String -> [Header] -> Frame
  mkUnsubscribe :: String -> String -> String -> [Header] -> Frame
mkUnsubscribe String
dst String
sid String
rc [Header]
hs =
    USubFrame :: String -> String -> String -> [Header] -> Frame
USubFrame {
      frmDest :: String
frmDest = String
dst,
      frmId :: String
frmId   = String
sid,
      frmRec :: String
frmRec  = String
rc,
      frmHdrs :: [Header]
frmHdrs = [Header]
hs}
 
  ----------------------------------------------------------------------
  -- | make a 'Send' frame (Application -> Broker).
  --   The parameters are:
  --
  --   * Destination: The name of the queue 
  --                  where the message should be published
  --
  --   * Transaction: A unique identifier indicating
  --                  a running transaction;
  --                  if sent with a transaction,
  --                  the message will not be delivered
  --                  to subscribing applications,
  --                  before the transaction is committed.
  --                  If the 'Send' is not part of a transaction,
  --                  the string shall be empty.
  --
  --   * Receipt: A receipt (see 'mkSubscribe' for details)
  --
  --   * 'Mime.Type': The content type of the payload message
  --                  as MIME Type
  --
  --   * Length: The length of the type in bytes
  --
  --   * 'Header': List of additional headers;
  --               Stomp protocol requires that user-specified
  --               headers are passed through to subscribing applications.
  --               These headers may, for instance, be use
  --               by selectors to select messages. 
  --
  --   * 'Body': The payload message
  ----------------------------------------------------------------------
  mkSend :: String    -> String -> String   -> 
            Mime.Type -> Int    -> [Header] -> 
            Body      -> Frame
  mkSend :: String
-> String -> String -> Type -> Int -> [Header] -> Body -> Frame
mkSend String
dst String
trn String
rec Type
mime Int
len [Header]
hs Body
bdy = 
    SndFrame :: [Header]
-> String -> String -> String -> Int -> Type -> Body -> Frame
SndFrame {
      frmHdrs :: [Header]
frmHdrs  = [Header]
hs,
      frmDest :: String
frmDest  = String
dst,
      frmTrans :: String
frmTrans = String
trn,
      frmRec :: String
frmRec   = String
rec,
      frmLen :: Int
frmLen   = Int
len,
      frmMime :: Type
frmMime  = Type
mime,
      frmBody :: Body
frmBody  = Body
bdy}

  ----------------------------------------------------------------------
  -- | make a 'Message' frame (Broker -> Application).
  --   The parameters are:
  --
  --   * Subscription Id: The message was sent
  --                      because the application subscribed to the queue
  --                      with this subscription id (see 'mkSubscribe').
  --
  --   * Destination: The name of the queue, in wich the message was published.
  --
  --   * Message Id: A unique message identifier, defined by the broker
  --
  --   * 'Mime.Type': The type of the playload as MIME Type
  --
  --   * Length: The length of the payload in bytes
  --
  --   * 'Header': A list of user-defined headers (see 'mkSend' for details)
  --
  --   * 'Body': The payload
  ----------------------------------------------------------------------
  mkMessage :: String    -> String -> String   -> String ->
               Mime.Type -> Int    -> [Header] -> 
               Body      -> Frame
  mkMessage :: String
-> String
-> String
-> String
-> Type
-> Int
-> [Header]
-> Body
-> Frame
mkMessage String
sub String
dst String
mid String
ack Type
mime Int
len [Header]
hs Body
bdy =
    MsgFrame :: [Header]
-> String
-> String
-> String
-> String
-> Int
-> Type
-> Body
-> Frame
MsgFrame {
      frmHdrs :: [Header]
frmHdrs  = [Header]
hs,
      frmSub :: String
frmSub   = String
sub,
      frmDest :: String
frmDest  = String
dst,
      frmAckId :: String
frmAckId = String
ack,
      frmId :: String
frmId    = String
mid,
      frmLen :: Int
frmLen   = Int
len,
      frmMime :: Type
frmMime  = Type
mime,
      frmBody :: Body
frmBody  = Body
bdy}

  ----------------------------------------------------------------------
  -- | make a 'Begin' frame (Application -> Broker).
  --   The parameters are:
  --
  --   * Transaction: A unique transaction identifier
  --                  defined by the application. 
  --
  --   * Receipt: A receipt (see 'mkSubscribe' for details)
  --
  --   * 'Header': Additional, broker-specific headers
  ----------------------------------------------------------------------
  mkBegin  :: String -> String -> [Header] -> Frame
  mkBegin :: String -> String -> [Header] -> Frame
mkBegin = String -> String -> [Header] -> Frame
BgnFrame

  ----------------------------------------------------------------------
  -- | make a 'Commit' frame (Application -> Broker).
  --   The parameters are:
  --
  --   * 'Transaction': A unique transaction identifier
  --                  defined by the application. 
  --
  --   * 'Receipt': A receipt (see 'mkSubscribe' for details)
  --
  --   * 'Header': Additional, broker-specific headers
  ----------------------------------------------------------------------
  mkCommit :: String -> String -> [Header] -> Frame
  mkCommit :: String -> String -> [Header] -> Frame
mkCommit = String -> String -> [Header] -> Frame
CmtFrame

  ----------------------------------------------------------------------
  -- | make an 'Abort' frame (Application -> Broker).
  --   The parameters are:
  --
  --   * Transaction: A unique transaction identifier
  --                  defined by the application. 
  --
  --   * Receipt: A receipt (see 'mkSubscribe' for details)
  --
  --   * 'Header': Additional, broker-specific headers
  ----------------------------------------------------------------------
  mkAbort  :: String -> String -> [Header] -> Frame
  mkAbort :: String -> String -> [Header] -> Frame
mkAbort = String -> String -> [Header] -> Frame
AbrtFrame

  ----------------------------------------------------------------------
  -- | make an 'Ack' frame (Application -> Broker).
  --   The parameters are:
  --
  --   * Message Id: The identifier of the message to be ack'd
  --
  --   * Subscription Id: The subscription, through which
  --                      the message was received
  --
  --   * Transaction: Acks may be part of a transaction
  --                  (see 'mkSend' for details).
  --
  --   * Receipt: see 'mkSubscribe' for details
  ----------------------------------------------------------------------
  mkAck :: String -> String -> String -> String -> [Header] -> Frame
  mkAck :: String -> String -> String -> String -> [Header] -> Frame
mkAck String
mid String
sid String
trn String
rc [Header]
hs = AckFrame :: String -> String -> String -> String -> [Header] -> Frame
AckFrame {
                             frmId :: String
frmId    = String
mid,
                             frmSub :: String
frmSub   = String
sid,
                             frmTrans :: String
frmTrans = String
trn,
                             frmRec :: String
frmRec   = String
rc,
                             frmHdrs :: [Header]
frmHdrs  = [Header]
hs}

  ----------------------------------------------------------------------
  -- | make a 'Nack' frame (Application -> Broker).
  --   The parameters are:
  --
  --   * Message Id: The identifier of the message to be nack'd
  --
  --   * Subscription Id: The subscription, through which
  --                      the message was received
  --
  --   * Transaction: Nacks may be part of a transaction
  --                  (see 'mkSend' for details).
  --
  --   * Receipt: see 'mkSubscribe' for details
  ----------------------------------------------------------------------
  mkNack :: String -> String -> String -> String -> [Header] -> Frame
  mkNack :: String -> String -> String -> String -> [Header] -> Frame
mkNack String
mid String
sid String
trn String
rc [Header]
hs = NackFrame :: String -> String -> String -> String -> [Header] -> Frame
NackFrame {
                               frmId :: String
frmId    = String
mid,
                               frmSub :: String
frmSub   = String
sid,
                               frmTrans :: String
frmTrans = String
trn,
                               frmRec :: String
frmRec   = String
rc,
                               frmHdrs :: [Header]
frmHdrs  = [Header]
hs}

  ----------------------------------------------------------------------
  -- | make a 'HeatBeat' frame (Application -> Broker and
  --                            Broker      -> Application)
  ----------------------------------------------------------------------
  mkBeat :: Frame
  mkBeat :: Frame
mkBeat = Frame
BeatFrame

  ----------------------------------------------------------------------
  -- | make a 'Disconnect' frame (Application -> Broker).
  --   The parameter is:
  --
  --   * Receipt: see 'mkSubscribe' for details
  ----------------------------------------------------------------------
  mkDisconnect :: String -> [Header] -> Frame
  mkDisconnect :: String -> [Header] -> Frame
mkDisconnect = String -> [Header] -> Frame
DisFrame 

  ----------------------------------------------------------------------
  -- | make a 'Receipt' frame (Broker -> Application).
  --   The parameter is:
  -- 
  --   * Receipt: The receipt identifier received from the application
  --
  --   * 'Header': List of additional, broker-specific headers
  ----------------------------------------------------------------------
  mkReceipt :: String -> [Header] -> Frame
  mkReceipt :: String -> [Header] -> Frame
mkReceipt = String -> [Header] -> Frame
RecFrame 

  ----------------------------------------------------------------------
  -- | make a 'Receipt' frame (Broker -> Application).
  --   The parameters are:
  --
  --   * Error Message Id: A short error description
  --
  --   * Receipt Id: The receipt of frame sent by the application
  --                 to which this error relates
  --
  --   * 'Mime.Type': The format of the error message as MIME Type
  --
  --   * Length: The length of the error message
  --
  --   * 'Header': List of additional, broker-specific headers
  --
  --   * 'Body': The error message
  ----------------------------------------------------------------------
  mkErr :: String -> String -> Mime.Type -> Int -> [Header] -> Body -> Frame
  mkErr :: String -> String -> Type -> Int -> [Header] -> Body -> Frame
mkErr String
mid String
rc Type
mime Int
len [Header]
hs Body
bdy =
    ErrFrame :: String -> String -> Int -> Type -> [Header] -> Body -> Frame
ErrFrame {
      frmMsg :: String
frmMsg  = String
mid,
      frmRec :: String
frmRec  = String
rc,
      frmLen :: Int
frmLen  = Int
len,
      frmMime :: Type
frmMime = Type
mime,
      frmBody :: Body
frmBody = Body
bdy,
      frmHdrs :: [Header]
frmHdrs = [Header]
hs}

  ------------------------------------------------------------------------
  -- | get /destination/ 
  --   from 'Subscribe', 'Unsubscribe', 'Send' or 'Message'
  ------------------------------------------------------------------------
  getDest :: Frame -> String
  getDest :: Frame -> String
getDest = Frame -> String
frmDest
  ------------------------------------------------------------------------
  -- | get /transaction/ from 'Send', 'Ack', 'Nack', 
  --                          'Begin', 'Commit' or 'Abort'
  ------------------------------------------------------------------------
  getTrans :: Frame -> String
  getTrans :: Frame -> String
getTrans = Frame -> String
frmTrans 
  ------------------------------------------------------------------------
  -- | get /receipt/ or /receipt-id/ from any frame, but
  --   'Connect', 'Connected', 'Message', 'Error'
  ------------------------------------------------------------------------
  getReceipt :: Frame -> String
  getReceipt :: Frame -> String
getReceipt = Frame -> String
frmRec
  ------------------------------------------------------------------------
  -- | get /host/ from 'Connect'
  ------------------------------------------------------------------------
  getHost :: Frame -> String
  getHost :: Frame -> String
getHost = Frame -> String
frmHost
  ------------------------------------------------------------------------
  -- | get /accept-version/ from 'Connect'
  ------------------------------------------------------------------------
  getVersions :: Frame -> [Version]
  getVersions :: Frame -> [Heart]
getVersions = Frame -> [Heart]
frmAcVer
  ------------------------------------------------------------------------
  -- | get /heart-beat/ from 'Connect' or 'Connected'
  ------------------------------------------------------------------------
  getBeat :: Frame -> Heart
  getBeat :: Frame -> Heart
getBeat = Frame -> Heart
frmBeat
  ------------------------------------------------------------------------
  -- | get /login/ from 'Connect'
  ------------------------------------------------------------------------
  getLogin :: Frame -> String
  getLogin :: Frame -> String
getLogin = Frame -> String
frmLogin 
  ------------------------------------------------------------------------
  -- | get /passcode/ from 'Connect'
  ------------------------------------------------------------------------
  getPasscode :: Frame -> String
  getPasscode :: Frame -> String
getPasscode = Frame -> String
frmPass
  ------------------------------------------------------------------------
  -- | get /client-id/ from 'Connect'
  ------------------------------------------------------------------------
  getCliId :: Frame -> String
  getCliId :: Frame -> String
getCliId = Frame -> String
frmCliId
  ------------------------------------------------------------------------
  -- | get /version/ from 'Connected'
  ------------------------------------------------------------------------
  getVersion :: Frame -> Version
  getVersion :: Frame -> Heart
getVersion = Frame -> Heart
frmVer
  ------------------------------------------------------------------------
  -- | get /session/ from 'Connected'
  ------------------------------------------------------------------------
  getSession :: Frame -> String
  getSession :: Frame -> String
getSession = Frame -> String
frmSes
  ------------------------------------------------------------------------
  -- | get /server/ from 'Connected'
  ------------------------------------------------------------------------
  getServer :: Frame -> SrvDesc
  getServer :: Frame -> SrvDesc
getServer = Frame -> SrvDesc
frmSrv
  ------------------------------------------------------------------------
  -- | get /id/ from 'Subscribe' or 'Unsubscribe'
  ------------------------------------------------------------------------
  getId :: Frame -> String
  getId :: Frame -> String
getId = Frame -> String
frmId
  ------------------------------------------------------------------------
  -- | get /ack/ from 'Subscribe'
  ------------------------------------------------------------------------
  getAcknow :: Frame -> AckMode
  getAcknow :: Frame -> AckMode
getAcknow = Frame -> AckMode
frmAck
  ------------------------------------------------------------------------
  -- | get /selector/ from 'Subscribe'
  ------------------------------------------------------------------------
  getSelector :: Frame -> String
  getSelector :: Frame -> String
getSelector = Frame -> String
frmSel
  ------------------------------------------------------------------------
  -- | get /subscription/ from 'Ack', 'Nack' or 'Message'
  ------------------------------------------------------------------------
  getSub :: Frame -> String
  getSub :: Frame -> String
getSub = Frame -> String
frmSub
  ------------------------------------------------------------------------
  -- | get /ack/ or /message-id/ from 'Message'
  ------------------------------------------------------------------------
  getMsgAck :: Frame -> String
  getMsgAck :: Frame -> String
getMsgAck Frame
f | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Frame -> String
frmAckId Frame
f) = Frame -> String
frmId    Frame
f
              | Bool
otherwise         = Frame -> String
frmAckId Frame
f
  ------------------------------------------------------------------------
  -- | get /body/ from 'Send', 'Message', 'Error'
  ------------------------------------------------------------------------
  getBody :: Frame -> B.ByteString
  getBody :: Frame -> Body
getBody = Frame -> Body
frmBody
  ------------------------------------------------------------------------
  -- | get /content-type/ from 'Send', 'Message', 'Error'
  ------------------------------------------------------------------------
  getMime :: Frame -> Mime.Type
  getMime :: Frame -> Type
getMime = Frame -> Type
frmMime
  ------------------------------------------------------------------------
  -- | get /content-length/ from 'Send', 'Message', 'Error'
  ------------------------------------------------------------------------
  getLength :: Frame -> Int
  getLength :: Frame -> Int
getLength = Frame -> Int
frmLen
  ------------------------------------------------------------------------
  -- | get /message/ from 'Error'
  ------------------------------------------------------------------------
  getMsg :: Frame -> String
  getMsg :: Frame -> String
getMsg = Frame -> String
frmMsg
  ------------------------------------------------------------------------
  -- | get all additional headers from 'Send' or 'Message'
  ------------------------------------------------------------------------
  getHeaders :: Frame -> [Header]
  getHeaders :: Frame -> [Header]
getHeaders = Frame -> [Header]
frmHdrs

  ------------------------------------------------------------------------
  -- | The frame type identifies, what the Stomp protocol calls /command/;
  --   
  --   * commands sent from application to broker are:
  --     Connect, Disconnect, Subscribe, Unsubscribe, Send, 
  --     Begin, Commit, Abort, Ack, Nack, HeartBeat
  --
  --   * commands sent from broker to application are:
  --     Connected, Message, Error, HeartBeat
  ------------------------------------------------------------------------
  data FrameType = 
    -- | Sent by the application to initiate a connection
    Connect   
    -- | Same as Connect, but with "STOMP" instead of "CONNECT"
    | Stomp
    -- | Sent by the broker to confirm the connection
    | Connected   
    -- | Sent by the application to end the connection
    | Disconnect 
    -- | Sent by the application to publish a message in a queue
    | Send       
    -- | Sent by the broker to forward a message
    --   published in a queue to which
    --   the application has subscribed
    | Message 
    -- | Sent by the application to subscribe to a queue
    | Subscribe 
    -- | Sent by the application to unsubscribe from a queue
    | Unsubscribe
    -- | Sent by the application to start a transaction
    | Begin
    -- | Sent by the application to commit a transaction
    | Commit
    -- | Sent by the application to abort a transaction
    | Abort
    -- | Sent by the application to acknowledge a message
    | Ack
    -- | Sent by the application to negatively acknowledge a message
    | Nack
    -- | Keep-alive message sent by both, application and broker
    | HeartBeat
    -- | Sent by the broker to report an error
    | Error   
    -- | Sent by the broker to confirm the receipt of a frame
    | Receipt 
    deriving (Int -> FrameType -> ShowS
[FrameType] -> ShowS
FrameType -> String
(Int -> FrameType -> ShowS)
-> (FrameType -> String)
-> ([FrameType] -> ShowS)
-> Show FrameType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameType] -> ShowS
$cshowList :: [FrameType] -> ShowS
show :: FrameType -> String
$cshow :: FrameType -> String
showsPrec :: Int -> FrameType -> ShowS
$cshowsPrec :: Int -> FrameType -> ShowS
Show, ReadPrec [FrameType]
ReadPrec FrameType
Int -> ReadS FrameType
ReadS [FrameType]
(Int -> ReadS FrameType)
-> ReadS [FrameType]
-> ReadPrec FrameType
-> ReadPrec [FrameType]
-> Read FrameType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FrameType]
$creadListPrec :: ReadPrec [FrameType]
readPrec :: ReadPrec FrameType
$creadPrec :: ReadPrec FrameType
readList :: ReadS [FrameType]
$creadList :: ReadS [FrameType]
readsPrec :: Int -> ReadS FrameType
$creadsPrec :: Int -> ReadS FrameType
Read, FrameType -> FrameType -> Bool
(FrameType -> FrameType -> Bool)
-> (FrameType -> FrameType -> Bool) -> Eq FrameType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameType -> FrameType -> Bool
$c/= :: FrameType -> FrameType -> Bool
== :: FrameType -> FrameType -> Bool
$c== :: FrameType -> FrameType -> Bool
Eq)

  ------------------------------------------------------------------------
  -- | gets the 'FrameType' of a 'Frame'
  ------------------------------------------------------------------------
  typeOf :: Frame -> FrameType
  typeOf :: Frame -> FrameType
typeOf Frame
f = case Frame
f of
              ConFrame   {} -> FrameType
Connect
              StompFrame {} -> FrameType
Stomp
              CondFrame  {} -> FrameType
Connected
              DisFrame   {} -> FrameType
Disconnect
              SubFrame   {} -> FrameType
Subscribe
              USubFrame  {} -> FrameType
Unsubscribe
              SndFrame   {} -> FrameType
Send
              BgnFrame   {} -> FrameType
Begin
              CmtFrame   {} -> FrameType
Commit
              AbrtFrame  {} -> FrameType
Abort
              AckFrame   {} -> FrameType
Ack
              NackFrame  {} -> FrameType
Nack
              MsgFrame   {} -> FrameType
Message
              RecFrame   {} -> FrameType
Receipt
              ErrFrame   {} -> FrameType
Error
              BeatFrame  {} -> FrameType
HeartBeat

  ------------------------------------------------------------------------
  -- The AckMode of a Subscription
  ------------------------------------------------------------------------
  data AckMode = 
    -- | A successfully sent message is automatically considered ack\'d
    Auto 
    -- | The client is expected to explicitly confirm the receipt
    --   of a message by sending an 'Ack' frame;
    --   all message older than the ack'd message
    --   since the last 'Ack' (or the beginning of the session)
    --   are implicitly ack\'d as well.
    --   This is called /cumulative/ ack.
    | Client 
    -- | Non-cumulative ack:
    --   The client is expected to explicitly confirm the receipt
    --   of a message by sending an 'Ack' frame;
    --   only the message with the msg-id in the 'Ack' frame
    --   is actually ack\'d
    | ClientIndi
    deriving (AckMode -> AckMode -> Bool
(AckMode -> AckMode -> Bool)
-> (AckMode -> AckMode -> Bool) -> Eq AckMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AckMode -> AckMode -> Bool
$c/= :: AckMode -> AckMode -> Bool
== :: AckMode -> AckMode -> Bool
$c== :: AckMode -> AckMode -> Bool
Eq)

  instance Show AckMode where
    show :: AckMode -> String
show AckMode
Auto       = String
"auto"
    show AckMode
Client     = String
"client"
    show AckMode
ClientIndi = String
"client-individual"

  instance Read AckMode where
    readsPrec :: Int -> ReadS AckMode
readsPrec Int
_ String
s = case ShowS
upString String
s of
                     String
"AUTO"              -> [(AckMode
Auto, String
"")]
                     String
"CLIENT"            -> [(AckMode
Client, String
"")]
                     String
"CLIENT-INDIVIDUAL" -> [(AckMode
ClientIndi, String
"")]
                     String
_                   -> ReadS AckMode
forall a. HasCallStack => String -> a
error ReadS AckMode -> ReadS AckMode
forall a b. (a -> b) -> a -> b
$ String
"Can't parse AckMode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
                   
  infixr >|<, |>, <| 
  -- | append
  (>|<) :: B.ByteString -> B.ByteString -> B.ByteString
  -- | snoc
  (|>)  :: B.ByteString -> Word8        -> B.ByteString
  -- | cons
  (<|)  :: Word8        -> B.ByteString -> B.ByteString
  Body
x >|< :: Body -> Body -> Body
>|< Body
y = Body
x Body -> Body -> Body
`B.append` Body
y
  Word8
x <| :: Word8 -> Body -> Body
<|  Body
y = Word8
x Word8 -> Body -> Body
`B.cons` Body
y
  Body
x  |> :: Body -> Word8 -> Body
|> Word8
y = Body
x Body -> Word8 -> Body
`B.snoc` Word8
y

  ----------------------------------------------------------------
  -- | check if 'String' represents a valid 'AckMode'
  ----------------------------------------------------------------
  isValidAck :: String -> Bool
  isValidAck :: String -> Bool
isValidAck String
s = ShowS
upString String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"AUTO", String
"CLIENT", String
"CLIENT-INDIVIDUAL"]

  upString :: String -> String
  upString :: ShowS
upString = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper

  numeric :: String -> Bool
  numeric :: String -> Bool
numeric = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit

  cleanWhite :: String -> String
  cleanWhite :: ShowS
cleanWhite = 
    (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')

  getLen :: [Header] -> Either String Int
  getLen :: [Header] -> Either String Int
getLen [Header]
hs = 
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrLen [Header]
hs of
      Maybe String
Nothing -> Int -> Either String Int
forall a b. b -> Either a b
Right (-Int
1) -- -1 means no content-length header!
      Just String
l  -> let len :: String
len = ShowS
cleanWhite String
l
                 in if String -> Bool
numeric String
len then Int -> Either String Int
forall a b. b -> Either a b
Right (Int -> Either String Int) -> Int -> Either String Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
len 
                      else String -> Either String Int
forall a b. a -> Either a b
Left (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ String
"content-length is not numeric: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l

  getAck :: [Header] -> Either String AckMode
  getAck :: [Header] -> Either String AckMode
getAck [Header]
hs = 
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrAck [Header]
hs of
      Maybe String
Nothing -> AckMode -> Either String AckMode
forall a b. b -> Either a b
Right AckMode
Auto
      Just String
a  -> if String -> Bool
isValidAck String
a 
                   then AckMode -> Either String AckMode
forall a b. b -> Either a b
Right (AckMode -> Either String AckMode)
-> AckMode -> Either String AckMode
forall a b. (a -> b) -> a -> b
$ String -> AckMode
forall a. Read a => String -> a
read String
a 
                   else String -> Either String AckMode
forall a b. a -> Either a b
Left  (String -> Either String AckMode)
-> String -> Either String AckMode
forall a b. (a -> b) -> a -> b
$ String
"Invalid ack header in Subscribe Frame: " 
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a

  ------------------------------------------------------------------------ 
  -- | convert list of 'Version' to 'String'
  ------------------------------------------------------------------------
  versToVal :: [Version] -> String
  versToVal :: [Heart] -> String
versToVal = (Heart -> ShowS) -> String -> [Heart] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> ShowS
addVer (String -> ShowS) -> (Heart -> String) -> Heart -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Heart -> String
verToVal) String
"" 
    where addVer :: String -> ShowS
addVer String
v String
vs = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
vs
                          then String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
vs
                          else String
v

  ------------------------------------------------------------------------ 
  -- | convert 'Version' to 'String'
  ------------------------------------------------------------------------
  verToVal :: Version -> String
  verToVal :: Heart -> String
verToVal (Int
major, Int
minor) = Int -> String
forall a. Show a => a -> String
show Int
major String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minor

  ------------------------------------------------------------------------ 
  -- | convert 'String' to list of 'Version'
  ------------------------------------------------------------------------
  valToVers :: String -> Maybe [Version]
  valToVers :: String -> Maybe [Heart]
valToVers String
s = case (Maybe Heart -> Bool) -> [Maybe Heart] -> Maybe (Maybe Heart)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Maybe Heart -> Maybe Heart -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Heart
forall a. Maybe a
Nothing) [Maybe Heart]
vs of
                  Maybe (Maybe Heart)
Nothing -> [Heart] -> Maybe [Heart]
forall a. a -> Maybe a
Just ([Heart] -> Maybe [Heart]) -> [Heart] -> Maybe [Heart]
forall a b. (a -> b) -> a -> b
$ [Maybe Heart] -> [Heart]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Heart]
vs
                  Just Maybe Heart
_  -> Maybe [Heart]
forall a. Maybe a
Nothing
    where ss :: [String]
ss = (Char -> Bool) -> String -> [String]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') String
s 
          vs :: [Maybe Heart]
vs = (String -> Maybe Heart) -> [String] -> [Maybe Heart]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe Heart
valToVer [String]
ss

  ------------------------------------------------------------------------ 
  -- | convert 'String' to 'Version'
  ------------------------------------------------------------------------
  valToVer :: String -> Maybe Version
  valToVer :: String -> Maybe Heart
valToVer String
v = if String -> Bool
numeric String
major Bool -> Bool -> Bool
&& String -> Bool
numeric String
minor 
                 then Heart -> Maybe Heart
forall a. a -> Maybe a
Just (String -> Int
forall a. Read a => String -> a
read String
major, String -> Int
forall a. Read a => String -> a
read String
minor)
                 else Maybe Heart
forall a. Maybe a
Nothing
    where major :: String
major = ShowS
cleanWhite ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
v
          minor :: String
minor = ShowS
cleanWhite ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.')) String
v

  ------------------------------------------------------------------------ 
  -- | convert 'HeartBeat' to 'String' 
  ------------------------------------------------------------------------
  beatToVal :: Heart -> String
  beatToVal :: Heart -> String
beatToVal (Int
x, Int
y) = Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y

  ------------------------------------------------------------------------ 
  -- | convert 'String' to 'HeartBeat' 
  ------------------------------------------------------------------------
  valToBeat :: String -> Maybe Heart
  valToBeat :: String -> Maybe Heart
valToBeat String
s = if String -> Bool
numeric String
send Bool -> Bool -> Bool
&& String -> Bool
numeric String
recv
                  then Heart -> Maybe Heart
forall a. a -> Maybe a
Just (String -> Int
forall a. Read a => String -> a
read String
send, String -> Int
forall a. Read a => String -> a
read String
recv)
                  else Maybe Heart
forall a. Maybe a
Nothing
    where send :: String
send = (ShowS
cleanWhite ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')) String
s
          recv :: String
recv = (ShowS
cleanWhite ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',')) String
s

  ------------------------------------------------------------------------ 
  -- | convert 'SrvDesc' to 'String' 
  ------------------------------------------------------------------------
  srvToStr :: SrvDesc -> String
  srvToStr :: SrvDesc -> String
srvToStr (String
n, String
v, String
c) = String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c'
    where c' :: String
c' = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
c then String
"" else Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
c

  ------------------------------------------------------------------------ 
  -- | convert 'String' to 'SrvDesc' 
  ------------------------------------------------------------------------
  strToSrv :: String -> SrvDesc
  strToSrv :: String -> SrvDesc
strToSrv String
s = (String
n, String
v, String
c)
    where n :: String
n = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') String
s
          v :: String
v = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
s
          c :: String
c = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
s

  ------------------------------------------------------------------------ 
  -- | remove headers (list of 'String') from list of 'Header'
  ------------------------------------------------------------------------
  rmHdrs :: [Header] -> [String] -> [Header]
  rmHdrs :: [Header] -> [String] -> [Header]
rmHdrs = ([Header] -> String -> [Header])
-> [Header] -> [String] -> [Header]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Header] -> String -> [Header]
rmHdr 

  ------------------------------------------------------------------------ 
  -- | remove header ('String') from list of 'Header'
  ------------------------------------------------------------------------
  rmHdr :: [Header] -> String -> [Header]
  rmHdr :: [Header] -> String -> [Header]
rmHdr [] String
_ = []
  rmHdr ((String
k,String
v):[Header]
hs) String
key | String
k String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
key  = [Header] -> String -> [Header]
rmHdr [Header]
hs String
key
                       | Bool
otherwise = (String
k,String
v) Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header] -> String -> [Header]
rmHdr [Header]
hs String
key

  ------------------------------------------------------------------------
  -- | convert 'AckMode' to 'String'
  ------------------------------------------------------------------------
  ackToVal :: AckMode -> String
  ackToVal :: AckMode -> String
ackToVal = AckMode -> String
forall a. Show a => a -> String
show 

  ------------------------------------------------------------------------
  -- | convert 'String' to 'AckMode'
  ------------------------------------------------------------------------
  valToAck :: String -> Maybe AckMode
  valToAck :: String -> Maybe AckMode
valToAck String
s = if String -> Bool
isValidAck String
s then AckMode -> Maybe AckMode
forall a. a -> Maybe a
Just (AckMode -> Maybe AckMode) -> AckMode -> Maybe AckMode
forall a b. (a -> b) -> a -> b
$ String -> AckMode
forall a. Read a => String -> a
read String
s else Maybe AckMode
forall a. Maybe a
Nothing

  ------------------------------------------------------------------------
  -- | negotiates version - 
  --   if no common version is found,
  --   the function results in version 1.0!
  ------------------------------------------------------------------------
  negoVersion :: [Version] -> [Version] -> Version
  negoVersion :: [Heart] -> [Heart] -> Heart
negoVersion [Heart]
bs = [Heart] -> [Heart] -> Heart
nego [Heart]
bs' 
    where bs' :: [Heart]
bs'  = (Heart -> Heart -> Ordering) -> [Heart] -> [Heart]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Heart -> Heart -> Ordering
desc [Heart]
bs
          desc :: Heart -> Heart -> Ordering
desc = (Heart -> Heart -> Ordering) -> Heart -> Heart -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Heart -> Heart -> Ordering
forall a. Ord a => a -> a -> Ordering
compare 
          nego :: [Heart] -> [Heart] -> Heart
nego []     [Heart]
_    = Heart
defVersion
          nego [Heart]
_     []    = Heart
defVersion
          nego (Heart
v:[Heart]
vs1) [Heart]
vs2 = if Heart
v Heart -> [Heart] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Heart]
vs2 then Heart
v else [Heart] -> [Heart] -> Heart
nego [Heart]
vs1 [Heart]
vs2

  ------------------------------------------------------------------------
  -- | negotiates heart-beat
  ------------------------------------------------------------------------
  negoBeat :: Heart -> Heart -> Heart
  negoBeat :: Heart -> Heart -> Heart
negoBeat Heart
hc Heart
hs = 
    let x :: Int
x = if Int
sndC Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
sndC Int
sndS
        y :: Int
y = if Int
rcvC Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
rcvC Int
rcvS
    in (Int
x, Int
y)
    where sndC :: Int
sndC = Heart -> Int
forall a b. (a, b) -> a
fst Heart
hc
          rcvC :: Int
rcvC = Heart -> Int
forall a b. (a, b) -> b
snd Heart
hc
          sndS :: Int
sndS = Heart -> Int
forall a b. (a, b) -> a
fst Heart
hs
          rcvS :: Int
rcvS = Heart -> Int
forall a b. (a, b) -> b
snd Heart
hs

  ------------------------------------------------------------------------
  -- | sets the transaction header to an empty string;
  --   this is a useful function for brokers:
  --   when a transaction has been committed,
  --   the 'Send' messages can be handled by the same function
  --   without, accidentally, iterating into a new transaction.
  ------------------------------------------------------------------------
  resetTrans :: Frame -> Frame
  resetTrans :: Frame -> Frame
resetTrans Frame
f = Frame
f {frmTrans :: String
frmTrans = String
""}

  ------------------------------------------------------------------------
  -- | converts a 'Frame' into a 'B.ByteString'
  ------------------------------------------------------------------------
  putFrame :: Frame -> B.ByteString
  putFrame :: Frame -> Body
putFrame Frame
BeatFrame = Frame -> Body
putCommand Frame
mkBeat
  putFrame Frame
f         = Frame -> Body
putCommand Frame
f Body -> Body -> Body
>|<
                       Frame -> Body
putHeaders Frame
f Body -> Body -> Body
>|<
                       Frame -> Body
putBody    Frame
f

  ------------------------------------------------------------------------
  -- | converts a 'Frame' into a 'String'
  ------------------------------------------------------------------------
  toString :: Frame -> String
  toString :: Frame -> String
toString = Body -> String
U.toString (Body -> String) -> (Frame -> Body) -> Frame -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Frame -> Body
putFrame

  ------------------------------------------------------------------------
  -- | converts the 'FrameType' into a 'B.ByteString'
  ------------------------------------------------------------------------
  putCommand :: Frame -> B.ByteString
  putCommand :: Frame -> Body
putCommand Frame
f = 
    let s :: String
s = case Frame -> FrameType
typeOf Frame
f of
              FrameType
Connect     -> String
"CONNECT"
              FrameType
Stomp       -> String
"STOMP"
              FrameType
Connected   -> String
"CONNECTED"
              FrameType
Disconnect  -> String
"DISCONNECT"
              FrameType
Send        -> String
"SEND"
              FrameType
Subscribe   -> String
"SUBSCRIBE"
              FrameType
Unsubscribe -> String
"UNSUBSCRIBE"
              FrameType
Begin       -> String
"BEGIN"
              FrameType
Commit      -> String
"COMMIT"
              FrameType
Abort       -> String
"ABORT"
              FrameType
Ack         -> String
"ACK"
              FrameType
Nack        -> String
"NACK"
              FrameType
Message     -> String
"MESSAGE"
              FrameType
Receipt     -> String
"RECEIPT"
              FrameType
Error       -> String
"ERROR"
              FrameType
HeartBeat   -> String
""
    in String -> Body
U.fromString String
s Body -> Word8 -> Body
|> Word8
0x0a

  ------------------------------------------------------------------------
  -- Convert headers to ByteString
  ------------------------------------------------------------------------
  putHeaders :: Frame -> B.ByteString
  putHeaders :: Frame -> Body
putHeaders Frame
f = 
    let hs :: [Header]
hs = Frame -> [Header]
toHeaders Frame
f 
        s :: Body
s  = [Body] -> Body
B.concat ([Body] -> Body) -> [Body] -> Body
forall a b. (a -> b) -> a -> b
$ (Header -> Body) -> [Header] -> [Body]
forall a b. (a -> b) -> [a] -> [b]
map Header -> Body
putHeader [Header]
hs
     in Body
s Body -> Word8 -> Body
|> Word8
0x0a

  ------------------------------------------------------------------------
  -- Convert header to ByteString
  ------------------------------------------------------------------------
  putHeader :: Header -> B.ByteString
  putHeader :: Header -> Body
putHeader Header
h =
    let k :: String
k = ShowS
esc ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Header -> String
forall a b. (a, b) -> a
fst Header
h
        v :: String
v = ShowS
esc ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Header -> String
forall a b. (a, b) -> b
snd Header
h
     in String -> Body
U.fromString (String -> Body) -> String -> Body
forall a b. (a -> b) -> a -> b
$ String
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
    where esc :: ShowS
esc    = (String -> Char -> String) -> String -> ShowS
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\String
l -> String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
l ShowS -> (Char -> String) -> Char -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
conv) []
          conv :: Char -> String
conv Char
c = case Char
c of 
                     Char
'\n' -> String
"\\n"
                     Char
'\r' -> String
"\\r"
                     Char
'\\' -> String
"\\\\"
                     Char
':'  -> String
"\\c"
                     Char
_    -> [Char
c]

  ------------------------------------------------------------------------
  -- Convert Frame attributes to headers
  ------------------------------------------------------------------------
  toHeaders :: Frame -> [Header]
  -- Connect Frame -------------------------------------------------------
  toHeaders :: Frame -> [Header]
toHeaders (ConFrame String
l String
p String
h Heart
b [Heart]
v String
i [Header]
hs) =
    let lh :: [Header]
lh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l     then [] else [String -> Header
mkLogHdr String
l]
        ph :: [Header]
ph = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p     then [] else [String -> Header
mkPassHdr String
p]
        bh :: [Header]
bh = if Heart
b Heart -> Heart -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0,Int
0) then [] else [String -> Header
mkBeatHdr (String -> Header) -> String -> Header
forall a b. (a -> b) -> a -> b
$ Heart -> String
beatToVal Heart
b]
        ih :: [Header]
ih = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i     then [] else [String -> Header
mkCliIdHdr String
i]
     in [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [String -> Header
mkAcVerHdr (String -> Header) -> String -> Header
forall a b. (a -> b) -> a -> b
$ [Heart] -> String
versToVal [Heart]
v, 
                     String -> Header
mkHostHdr String
h] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
lh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
ph [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
bh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
ih [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs 
  toHeaders (StompFrame String
l String
p String
h Heart
b [Heart]
v String
i [Header]
hs) =
    let lh :: [Header]
lh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
l     then [] else [String -> Header
mkLogHdr String
l]
        ph :: [Header]
ph = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p     then [] else [String -> Header
mkPassHdr String
p]
        bh :: [Header]
bh = if Heart
b Heart -> Heart -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0,Int
0) then [] else [String -> Header
mkBeatHdr (String -> Header) -> String -> Header
forall a b. (a -> b) -> a -> b
$ Heart -> String
beatToVal Heart
b]
        ih :: [Header]
ih = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i     then [] else [String -> Header
mkCliIdHdr String
i]
     in [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [String -> Header
mkAcVerHdr (String -> Header) -> String -> Header
forall a b. (a -> b) -> a -> b
$ [Heart] -> String
versToVal [Heart]
v, 
                     String -> Header
mkHostHdr String
h] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
lh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
ph [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
bh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
ih [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs 
  -- Connected Frame -----------------------------------------------------
  toHeaders (CondFrame String
s Heart
b Heart
v SrvDesc
d [Header]
hs) =
    let sh :: [Header]
sh = if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0"   then [] else [String -> Header
mkSesHdr String
s]
        bh :: [Header]
bh = if Heart
b Heart -> Heart -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0,Int
0) then [] else [String -> Header
mkBeatHdr (String -> Header) -> String -> Header
forall a b. (a -> b) -> a -> b
$ Heart -> String
beatToVal Heart
b]
        x :: String
x  = SrvDesc -> String
srvToStr SrvDesc
d
        dh :: [Header]
dh = if String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"/"   then [] else [String -> Header
mkSrvHdr String
x]
     in [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ String -> Header
mkVerHdr (Heart -> String
verToVal Heart
v) Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
sh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
bh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
dh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Disconnect Frame -----------------------------------------------------
  toHeaders (DisFrame String
r [Header]
hs) =
    if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [Header]
hs else [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ String -> Header
mkRecHdr String
r Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
hs
  -- Subscribe Frame ------------------------------------------------------
  toHeaders (SubFrame String
d AckMode
a String
s String
i String
r [Header]
hs) =
    let ah :: [Header]
ah = if AckMode
a AckMode -> AckMode -> Bool
forall a. Eq a => a -> a -> Bool
== AckMode
Auto then [] else [String -> Header
mkAckHdr (AckMode -> String
forall a. Show a => a -> String
show AckMode
a)]
        sh :: [Header]
sh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s    then [] else [String -> Header
mkSelHdr String
s]
        rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r    then [] else [String -> Header
mkRecHdr String
r]
        ih :: [Header]
ih = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i    then [] else [String -> Header
mkIdHdr String
i]
    in [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ String -> Header
mkDestHdr String
d Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: ([Header]
ah [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
sh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
ih [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh) [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Unsubscribe Frame ----------------------------------------------------
  toHeaders (USubFrame String
d String
i String
r [Header]
hs) =
    let ih :: [Header]
ih = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
i then [] else [String -> Header
mkIdHdr String
i]
        dh :: [Header]
dh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d then [] else [String -> Header
mkDestHdr String
d]
        rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else [String -> Header
mkRecHdr String
r]
    in [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [Header]
dh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
ih [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Send Frame -----------------------------------------------------------
  toHeaders (SndFrame [Header]
hs String
d String
t String
r Int
l Type
m Body
_) = 
    let th :: [Header]
th = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t then [] else [String -> Header
mkTrnHdr String
t]
        rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else [String -> Header
mkRecHdr String
r]
        lh :: [Header]
lh = if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then [] else [String -> Header
mkLenHdr (Int -> String
forall a. Show a => a -> String
show Int
l)]
    in [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [String -> Header
mkDestHdr String
d, 
                    String -> Header
mkMimeHdr (Type -> String
showType Type
m)] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
th [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
lh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Begin Frame -----------------------------------------------------------
  toHeaders (BgnFrame  String
t String
r [Header]
hs) = 
    let rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else [String -> Header
mkRecHdr String
r]
    in  [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [String -> Header
mkTrnHdr String
t] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Commit Frame -----------------------------------------------------------
  toHeaders (CmtFrame  String
t String
r [Header]
hs) = 
    let rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else [String -> Header
mkRecHdr String
r]
    in  [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [String -> Header
mkTrnHdr String
t] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Abort Frame -----------------------------------------------------------
  toHeaders (AbrtFrame String
t String
r [Header]
hs) = 
    let rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else [String -> Header
mkRecHdr String
r]
    in  [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [String -> Header
mkTrnHdr String
t] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Ack Frame --------------------------------------------------------------
  toHeaders (AckFrame String
i String
s String
t String
r [Header]
hs) =
    [Header] -> [Header]
normalise ([String -> Header
mkMIdHdr String
i, String -> Header
mkIdHdr String
i] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ String -> String -> String -> [Header]
subRecTrn String
s String
r String
t)
  -- Nack Frame -------------------------------------------------------------
  toHeaders (NackFrame String
i String
s String
t String
r [Header]
hs) = 
    [Header] -> [Header]
normalise ([String -> Header
mkMIdHdr String
i, String -> Header
mkIdHdr String
i] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ String -> String -> String -> [Header]
subRecTrn String
s String
r String
t)
  -- Message Frame ----------------------------------------------------------
  toHeaders (MsgFrame [Header]
hs String
s String
d String
i String
a Int
l Type
m Body
_)  = 
    let sh :: [Header]
sh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then [] else [String -> Header
mkSubHdr  String
s]
        dh :: [Header]
dh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d then [] else [String -> Header
mkDestHdr String
d]
        ah :: [Header]
ah = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
a then [] else [String -> Header
mkAckHdr  String
a]
        lh :: [Header]
lh = if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then [] else [String -> Header
mkLenHdr (Int -> String
forall a. Show a => a -> String
show Int
l)]
    in [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [String -> Header
mkMIdHdr String
i,
                    String -> Header
mkMimeHdr (Type -> String
showType Type
m)] 
                    [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
sh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
dh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
ah [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
lh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Receipt Frame ----------------------------------------------------------
  toHeaders (RecFrame  String
r [Header]
hs) = [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ String -> Header
mkRecIdHdr String
r Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
hs
  -- Error Frame ------------------------------------------------------------
  toHeaders (ErrFrame String
m String
r Int
l Type
t [Header]
hs Body
_) = 
    let mh :: [Header]
mh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
m then [] else [String -> Header
mkMsgHdr String
m]
        rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else [String -> Header
mkRecIdHdr String
r]
        lh :: [Header]
lh = if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then [] else [String -> Header
mkLenHdr (Int -> String
forall a. Show a => a -> String
show Int
l)]
    in  [Header] -> [Header]
normalise ([Header] -> [Header]) -> [Header] -> [Header]
forall a b. (a -> b) -> a -> b
$ [Header]
mh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
lh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [String -> Header
mkMimeHdr (String -> Header) -> String -> Header
forall a b. (a -> b) -> a -> b
$ Type -> String
showType Type
t] [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
hs
  -- Beat Frame --------------------------------------------------------------
  toHeaders Frame
BeatFrame = []

  subRecTrn :: String -> String -> String -> [Header]
  subRecTrn :: String -> String -> String -> [Header]
subRecTrn String
s String
r String
t =  
    let sh :: [Header]
sh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then [] else [String -> Header
mkSubHdr String
s]
        rh :: [Header]
rh = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else [String -> Header
mkRecHdr String
r]
        th :: [Header]
th = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t then [] else [String -> Header
mkTrnHdr String
t]
     in [Header]
sh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
rh [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ [Header]
th

  ----------------------------------------------------------------------------
  -- no duplicates, alphanumerical order
  ----------------------------------------------------------------------------
  normalise :: [Header] -> [Header]
  normalise :: [Header] -> [Header]
normalise = [Header] -> [Header]
forall a. Eq a => [a] -> [a]
nub

  ------------------------------------------------------------------------
  -- get body from frame
  ------------------------------------------------------------------------
  putBody :: Frame -> Body
  putBody :: Frame -> Body
putBody Frame
f =
    case Frame
f of 
      x :: Frame
x@SndFrame {} -> Frame -> Body
frmBody Frame
x Body -> Word8 -> Body
|> Word8
0x00
      x :: Frame
x@ErrFrame {} -> Frame -> Body
frmBody Frame
x Body -> Word8 -> Body
|> Word8
0x00
      x :: Frame
x@MsgFrame {} -> Frame -> Body
frmBody Frame
x Body -> Word8 -> Body
|> Word8
0x00
      Frame
_             -> Word8 -> Body
B.singleton Word8
0x00

  ------------------------------------------------------------------------
  -- find a header and return it as string value (with default)
  ------------------------------------------------------------------------
  findStrHdr :: String -> String -> [Header] -> String
  findStrHdr :: String -> String -> [Header] -> String
findStrHdr String
h String
d [Header]
hs = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
d (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
h [Header]
hs 

  ------------------------------------------------------------------------
  -- | make 'Connect' frame
  ------------------------------------------------------------------------
  mkConFrame :: [Header] -> Either String Frame
  mkConFrame :: [Header] -> Either String Frame
mkConFrame = (String
 -> String
 -> String
 -> Heart
 -> [Heart]
 -> String
 -> [Header]
 -> Frame)
-> [Header] -> Either String Frame
mkConTypeFrame String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
ConFrame

  ------------------------------------------------------------------------
  -- | make 'Stomp' frame
  ------------------------------------------------------------------------
  mkStmpFrame :: [Header] -> Either String Frame
  mkStmpFrame :: [Header] -> Either String Frame
mkStmpFrame = (String
 -> String
 -> String
 -> Heart
 -> [Heart]
 -> String
 -> [Header]
 -> Frame)
-> [Header] -> Either String Frame
mkConTypeFrame String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
StompFrame

  mkConTypeFrame :: (String -> String    -> String -> 
                     Heart  -> [Version] -> String -> [Header] -> Frame) ->
                    [Header] -> Either String Frame
  mkConTypeFrame :: (String
 -> String
 -> String
 -> Heart
 -> [Heart]
 -> String
 -> [Header]
 -> Frame)
-> [Header] -> Either String Frame
mkConTypeFrame String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mk [Header]
hs = 
    let l :: String
l   = String -> String -> [Header] -> String
findStrHdr String
hdrLog   String
"" [Header]
hs
        p :: String
p   = String -> String -> [Header] -> String
findStrHdr String
hdrPass  String
"" [Header]
hs
        h :: String
h   = String -> String -> [Header] -> String
findStrHdr String
hdrHost  String
"" [Header]
hs
        i :: String
i   = String -> String -> [Header] -> String
findStrHdr String
hdrCliId String
"" [Header]
hs
        eiB :: Either String Heart
eiB = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrBeat [Header]
hs of
                Maybe String
Nothing -> Heart -> Either String Heart
forall a b. b -> Either a b
Right Heart
noBeat
                Just String
x  -> case String -> Maybe Heart
valToBeat String
x of
                             Maybe Heart
Nothing -> String -> Either String Heart
forall a b. a -> Either a b
Left  (String -> Either String Heart) -> String -> Either String Heart
forall a b. (a -> b) -> a -> b
$ String
"Not a valid heart-beat: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
                             Just Heart
b  -> Heart -> Either String Heart
forall a b. b -> Either a b
Right Heart
b
        eiVs :: Either String [Heart]
eiVs = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrAcVer [Header]
hs of
                        Maybe String
Nothing -> [Heart] -> Either String [Heart]
forall a b. b -> Either a b
Right []
                        Just String
v  -> 
                          case String -> Maybe [Heart]
valToVers String
v of
                            Maybe [Heart]
Nothing -> String -> Either String [Heart]
forall a b. a -> Either a b
Left (String -> Either String [Heart])
-> String -> Either String [Heart]
forall a b. (a -> b) -> a -> b
$ String
"Not a valid version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v
                            Just [Heart]
x  -> [Heart] -> Either String [Heart]
forall a b. b -> Either a b
Right [Heart]
x
     in case Either String [Heart]
eiVs of
          Left  String
e  -> String -> Either String Frame
forall a b. a -> Either a b
Left String
e
          Right [Heart]
vs -> 
            case Either String Heart
eiB of
              Left  String
e -> String -> Either String Frame
forall a b. a -> Either a b
Left String
e
              Right Heart
b -> Frame -> Either String Frame
forall a b. b -> Either a b
Right (Frame -> Either String Frame) -> Frame -> Either String Frame
forall a b. (a -> b) -> a -> b
$ String
-> String
-> String
-> Heart
-> [Heart]
-> String
-> [Header]
-> Frame
mk String
l String
p String
h Heart
b [Heart]
vs String
i ([Header] -> Frame) -> [Header] -> Frame
forall a b. (a -> b) -> a -> b
$ 
                           [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrLog, String
hdrPass, String
hdrHost, String
hdrCliId]

  ------------------------------------------------------------------------
  -- | make 'Connected' frame
  ------------------------------------------------------------------------
  mkCondFrame :: [Header] -> Either String Frame
  mkCondFrame :: [Header] -> Either String Frame
mkCondFrame [Header]
hs =
    let s :: String
s   = String -> String -> [Header] -> String
findStrHdr String
hdrSes String
"0"       [Header]
hs
        v :: String
v   = String -> String -> [Header] -> String
findStrHdr String
hdrVer String
defVerStr [Header]
hs
        d :: SrvDesc
d   = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrSrv [Header]
hs of
                Maybe String
Nothing -> SrvDesc
noSrvDesc
                Just String
x  -> String -> SrvDesc
strToSrv String
x
        eiB :: Either String Heart
eiB = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrBeat [Header]
hs of
                Maybe String
Nothing -> Heart -> Either String Heart
forall a b. b -> Either a b
Right Heart
noBeat
                Just String
x  -> case String -> Maybe Heart
valToBeat String
x of
                             Maybe Heart
Nothing -> String -> Either String Heart
forall a b. a -> Either a b
Left (String -> Either String Heart) -> String -> Either String Heart
forall a b. (a -> b) -> a -> b
$ String
"Not a valid heart-beat: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
                             Just Heart
b  -> Heart -> Either String Heart
forall a b. b -> Either a b
Right Heart
b
    in case String -> Maybe Heart
valToVer String
v of
         Maybe Heart
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left (String -> Either String Frame) -> String -> Either String Frame
forall a b. (a -> b) -> a -> b
$ String
"Not a valid version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v
         Just Heart
v' -> case Either String Heart
eiB of 
                      Left  String
e -> String -> Either String Frame
forall a b. a -> Either a b
Left String
e
                      Right Heart
b -> Frame -> Either String Frame
forall a b. b -> Either a b
Right (Frame -> Either String Frame) -> Frame -> Either String Frame
forall a b. (a -> b) -> a -> b
$ String -> Heart -> Heart -> SrvDesc -> [Header] -> Frame
CondFrame String
s Heart
b Heart
v' SrvDesc
d ([Header] -> Frame) -> [Header] -> Frame
forall a b. (a -> b) -> a -> b
$ 
                                   [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrSes, String
hdrVer, String
hdrSrv, String
hdrBeat]

  ------------------------------------------------------------------------
  -- | make 'Disconnect' frame
  ------------------------------------------------------------------------
  mkDisFrame :: [Header] -> Either String Frame
  mkDisFrame :: [Header] -> Either String Frame
mkDisFrame [Header]
hs = 
    Frame -> Either String Frame
forall a b. b -> Either a b
Right (Frame -> Either String Frame) -> Frame -> Either String Frame
forall a b. (a -> b) -> a -> b
$ String -> [Header] -> Frame
DisFrame (String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs) ([Header] -> Frame) -> [Header] -> Frame
forall a b. (a -> b) -> a -> b
$ [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrRec]

  ------------------------------------------------------------------------
  -- | make 'Send' frame
  ------------------------------------------------------------------------
  mkSndFrame :: [Header] -> Int -> Body -> Either String Frame
  mkSndFrame :: [Header] -> Int -> Body -> Either String Frame
mkSndFrame [Header]
hs Int
l Body
b =
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrDest [Header]
hs of
      Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No destination header in SEND Frame"
      Just String
d  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right SndFrame :: [Header]
-> String -> String -> String -> Int -> Type -> Body -> Frame
SndFrame {
                           frmHdrs :: [Header]
frmHdrs  = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrMime, String
hdrTrn, String
hdrRec,
                                                 String
hdrDest, String
hdrLen],
                           frmDest :: String
frmDest  = String
d,
                           frmLen :: Int
frmLen   = Int
l,
                           frmMime :: Type
frmMime  = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrMime [Header]
hs of
                                        Maybe String
Nothing -> Type
defMime
                                        Just String
t  -> 
                                          Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
defMime (String -> Maybe Type
parseMIMEType String
t),
                           frmTrans :: String
frmTrans = String -> String -> [Header] -> String
findStrHdr String
hdrTrn String
"" [Header]
hs,
                           frmRec :: String
frmRec   = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs,
                           frmBody :: Body
frmBody  = Body
b
                         }

  ------------------------------------------------------------------------
  -- | make 'Message' frame
  ------------------------------------------------------------------------
  mkMsgFrame :: [Header] -> Int -> Body -> Either String Frame
  mkMsgFrame :: [Header] -> Int -> Body -> Either String Frame
mkMsgFrame [Header]
hs Int
l Body
b =
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrDest [Header]
hs of
      Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No destination header in MESSAGE Frame"
      Just String
d  -> case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrMId [Header]
hs of
                   Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No message id in MESSAGE Frame"
                   Just String
i  ->
                     Frame -> Either String Frame
forall a b. b -> Either a b
Right MsgFrame :: [Header]
-> String
-> String
-> String
-> String
-> Int
-> Type
-> Body
-> Frame
MsgFrame {
                             frmHdrs :: [Header]
frmHdrs  = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrSub, String
hdrMime, 
                                                   String
hdrLen, String
hdrDest,
                                                   String
hdrMId, String
hdrAckId],
                             frmDest :: String
frmDest  = String
d,
                             frmSub :: String
frmSub   = String -> String -> [Header] -> String
findStrHdr String
hdrSub   String
"" [Header]
hs,
                             frmAckId :: String
frmAckId = String -> String -> [Header] -> String
findStrHdr String
hdrAckId String
"" [Header]
hs, 
                             frmId :: String
frmId    = String
i, 
                             frmLen :: Int
frmLen   = Int
l,
                             frmMime :: Type
frmMime  = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrMime [Header]
hs of
                                          Maybe String
Nothing -> Type
defMime
                                          Just String
t  -> 
                                            Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
defMime (String -> Maybe Type
parseMIMEType String
t),
                             frmBody :: Body
frmBody = Body
b}

  ------------------------------------------------------------------------
  -- | make 'Subscribe' frame
  ------------------------------------------------------------------------
  mkSubFrame :: [Header] -> Either String Frame
  mkSubFrame :: [Header] -> Either String Frame
mkSubFrame [Header]
hs = 
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrDest [Header]
hs of
      Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No destination header in Subscribe Frame"
      Just String
d  -> case [Header] -> Either String AckMode
getAck [Header]
hs of
                   Left  String
e -> String -> Either String Frame
forall a b. a -> Either a b
Left String
e
                   Right AckMode
a -> Frame -> Either String Frame
forall a b. b -> Either a b
Right SubFrame :: String
-> AckMode -> String -> String -> String -> [Header] -> Frame
SubFrame {
                                      frmDest :: String
frmDest = String
d,
                                      frmAck :: AckMode
frmAck  = AckMode
a,
                                      -- id is mandatory, but we don't
                                      -- penalise when it's missing
                                      -- to maintain compatibility with 1.0
                                      frmId :: String
frmId   = String -> String -> [Header] -> String
findStrHdr String
hdrId  String
"" [Header]
hs,
                                      frmSel :: String
frmSel  = String -> String -> [Header] -> String
findStrHdr String
hdrSel String
"" [Header]
hs,
                                      frmRec :: String
frmRec  = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs,
                                      frmHdrs :: [Header]
frmHdrs = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrDest, String
hdrAck,
                                                           String
hdrSel, String
hdrId, 
                                                           String
hdrRec]}

  ------------------------------------------------------------------------
  -- | make 'Unsubscribe' frame
  ------------------------------------------------------------------------
  mkUSubFrame :: [Header] -> Either String Frame
  mkUSubFrame :: [Header] -> Either String Frame
mkUSubFrame [Header]
hs =
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrDest [Header]
hs of
      Maybe String
Nothing -> case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrId [Header]
hs of
                   Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left (String -> Either String Frame) -> String -> Either String Frame
forall a b. (a -> b) -> a -> b
$ String
"No destination and no id header " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                     String
"in UnSubscribe Frame"
                   Just String
i  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right USubFrame :: String -> String -> String -> [Header] -> Frame
USubFrame {
                                      frmId :: String
frmId   = String
i,
                                      frmDest :: String
frmDest = String
"",
                                      frmRec :: String
frmRec  = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs,
                                      frmHdrs :: [Header]
frmHdrs = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrId, String
hdrRec]}
      Just String
d  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right USubFrame :: String -> String -> String -> [Header] -> Frame
USubFrame {
                          -- id is mandatory, but we don't
                          -- penalise when it's missing
                          -- to maintain compatibility with 1.0
                          frmId :: String
frmId   = String -> String -> [Header] -> String
findStrHdr String
hdrId String
"" [Header]
hs,
                          frmDest :: String
frmDest = String
d,
                          frmRec :: String
frmRec  = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs,
                          frmHdrs :: [Header]
frmHdrs = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrId, String
hdrDest, String
hdrRec]}

  ------------------------------------------------------------------------
  -- | make 'Begin' frame
  ------------------------------------------------------------------------
  mkBgnFrame :: [Header] -> Either String Frame
  mkBgnFrame :: [Header] -> Either String Frame
mkBgnFrame [Header]
hs =
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrTrn [Header]
hs of
      Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No transation header in Begin Frame"
      Just String
t  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right BgnFrame :: String -> String -> [Header] -> Frame
BgnFrame {
                         frmTrans :: String
frmTrans = String
t,
                         frmRec :: String
frmRec   = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs,
                         frmHdrs :: [Header]
frmHdrs  = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrTrn, String
hdrRec]}

  ------------------------------------------------------------------------
  -- | make 'Commit' frame
  ------------------------------------------------------------------------
  mkCmtFrame :: [Header] -> Either String Frame
  mkCmtFrame :: [Header] -> Either String Frame
mkCmtFrame [Header]
hs =
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrTrn [Header]
hs of
      Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No transation header in Commit Frame"
      Just String
t  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right CmtFrame :: String -> String -> [Header] -> Frame
CmtFrame {
                         frmTrans :: String
frmTrans = String
t,
                         frmRec :: String
frmRec   = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs,
                         frmHdrs :: [Header]
frmHdrs  = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrTrn, String
hdrRec]}

  ------------------------------------------------------------------------
  -- | make 'Abort' frame
  ------------------------------------------------------------------------
  mkAbrtFrame :: [Header] -> Either String Frame
  mkAbrtFrame :: [Header] -> Either String Frame
mkAbrtFrame [Header]
hs =
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrTrn [Header]
hs of
      Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No transation header in Abort Frame"
      Just String
t  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right AbrtFrame :: String -> String -> [Header] -> Frame
AbrtFrame {
                         frmTrans :: String
frmTrans = String
t,
                         frmRec :: String
frmRec   = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs,
                         frmHdrs :: [Header]
frmHdrs  = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrTrn, String
hdrRec]}

  ------------------------------------------------------------------------
  -- | make 'Ack' frame
  ------------------------------------------------------------------------
  mkAckFrame :: [Header] -> Either String Frame
  mkAckFrame :: [Header] -> Either String Frame
mkAckFrame [Header]
hs =
    let mbI :: Maybe String
mbI = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrId [Header]
hs of
                  Maybe String
Nothing -> 
                    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrMId [Header]
hs of
                      Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
                      Just String
i  -> String -> Maybe String
forall a. a -> Maybe a
Just String
i
                  Just String
i  -> String -> Maybe String
forall a. a -> Maybe a
Just String
i
        (String
t,String
s,String
r) = [Header] -> SrvDesc
findSubRecTrn [Header]
hs
     in case Maybe String
mbI of 
          Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No id header in Ack Frame"
          Just String
i  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right AckFrame :: String -> String -> String -> String -> [Header] -> Frame
AckFrame {
                            frmId :: String
frmId    = String
i,
                            frmSub :: String
frmSub   = String
s,
                            frmTrans :: String
frmTrans = String
t,
                            frmRec :: String
frmRec   = String
r,
                            frmHdrs :: [Header]
frmHdrs  = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrMId, String
hdrId, String
hdrTrn, 
                                                  String
hdrSub, String
hdrRec]}

  ------------------------------------------------------------------------
  -- | make 'Nack' frame
  ------------------------------------------------------------------------
  mkNackFrame :: [Header] -> Either String Frame
  mkNackFrame :: [Header] -> Either String Frame
mkNackFrame [Header]
hs =
    let mbI :: Maybe String
mbI = case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrId [Header]
hs of
                  Maybe String
Nothing -> 
                    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrMId [Header]
hs of
                      Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
                      Just String
i  -> String -> Maybe String
forall a. a -> Maybe a
Just String
i
                  Just String
i  -> String -> Maybe String
forall a. a -> Maybe a
Just String
i
        (String
t,String
s,String
r) = [Header] -> SrvDesc
findSubRecTrn [Header]
hs
     in case Maybe String
mbI of 
          Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No id header in Ack Frame"
          Just String
i  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right NackFrame :: String -> String -> String -> String -> [Header] -> Frame
NackFrame {
                            frmId :: String
frmId    = String
i,
                            frmSub :: String
frmSub   = String
s,
                            frmTrans :: String
frmTrans = String
t,
                            frmRec :: String
frmRec   = String
r,
                            frmHdrs :: [Header]
frmHdrs  = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrMId, String
hdrId, String
hdrTrn, 
                                                  String
hdrSub, String
hdrRec]}


  findSubRecTrn :: [Header] -> (String, String, String)
  findSubRecTrn :: [Header] -> SrvDesc
findSubRecTrn [Header]
hs = 
      let t :: String
t = String -> String -> [Header] -> String
findStrHdr String
hdrTrn String
"" [Header]
hs
          s :: String
s = String -> String -> [Header] -> String
findStrHdr String
hdrSub String
"" [Header]
hs
          r :: String
r = String -> String -> [Header] -> String
findStrHdr String
hdrRec String
"" [Header]
hs
       in (String
t,String
s,String
r)

  ------------------------------------------------------------------------
  -- | make 'Receipt' frame
  ------------------------------------------------------------------------
  mkRecFrame :: [Header] -> Either String Frame
  mkRecFrame :: [Header] -> Either String Frame
mkRecFrame [Header]
hs =
    case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrRecId [Header]
hs of
      Maybe String
Nothing -> String -> Either String Frame
forall a b. a -> Either a b
Left String
"No receipt-id header in Receipt Frame"
      Just String
r  -> Frame -> Either String Frame
forall a b. b -> Either a b
Right (Frame -> Either String Frame) -> Frame -> Either String Frame
forall a b. (a -> b) -> a -> b
$ String -> [Header] -> Frame
RecFrame String
r ([Header] -> Frame) -> [Header] -> Frame
forall a b. (a -> b) -> a -> b
$ [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrRecId]

  ------------------------------------------------------------------------
  -- | make 'Error' frame
  ------------------------------------------------------------------------
  mkErrFrame :: [Header] -> Int -> Body -> Either String Frame
  mkErrFrame :: [Header] -> Int -> Body -> Either String Frame
mkErrFrame [Header]
hs Int
l Body
b =
    Frame -> Either String Frame
forall a b. b -> Either a b
Right ErrFrame :: String -> String -> Int -> Type -> [Header] -> Body -> Frame
ErrFrame {
            frmMsg :: String
frmMsg  = String -> String -> [Header] -> String
findStrHdr String
hdrMsg   String
"" [Header]
hs,
            frmRec :: String
frmRec  = String -> String -> [Header] -> String
findStrHdr String
hdrRecId String
"" [Header]
hs,
            frmLen :: Int
frmLen  = Int
l,
            frmMime :: Type
frmMime = 
              case String -> [Header] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
hdrMime [Header]
hs of
                Maybe String
Nothing -> Type
defMime
                Just String
t  -> Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
defMime (String -> Maybe Type
parseMIMEType String
t),
            frmHdrs :: [Header]
frmHdrs = [Header] -> [String] -> [Header]
rmHdrs [Header]
hs [String
hdrMime, String
hdrLen, String
hdrMsg, String
hdrRecId],
            frmBody :: Body
frmBody = Body
b}

  ------------------------------------------------------------------------
  -- | converts a 'Send' frame into a 'Message' frame;
  --   parameters:
  --   
  --   * message id
  --
  --   * subscription id
  --
  --   * ack id
  --
  --   * The original 'Send' frame
  ------------------------------------------------------------------------
  sndToMsg :: String -> String -> String -> Frame -> Maybe Frame
  sndToMsg :: String -> String -> String -> Frame -> Maybe Frame
sndToMsg String
i String
sub String
a Frame
f = case Frame -> FrameType
typeOf Frame
f of
                         FrameType
Send ->
                           Frame -> Maybe Frame
forall a. a -> Maybe a
Just MsgFrame :: [Header]
-> String
-> String
-> String
-> String
-> Int
-> Type
-> Body
-> Frame
MsgFrame {
                                 frmHdrs :: [Header]
frmHdrs  = Frame -> [Header]
frmHdrs Frame
f,
                                 frmDest :: String
frmDest  = Frame -> String
frmDest Frame
f,
                                 frmSub :: String
frmSub   = String
sub, 
                                 frmLen :: Int
frmLen   = Frame -> Int
frmLen  Frame
f,
                                 frmMime :: Type
frmMime  = Frame -> Type
frmMime Frame
f,
                                 frmId :: String
frmId    = String
i,
                                 frmAckId :: String
frmAckId = String
a,
                                 frmBody :: Body
frmBody  = Frame -> Body
frmBody Frame
f
                               }
                         FrameType
_ -> Maybe Frame
forall a. Maybe a
Nothing

  ------------------------------------------------------------------------
  -- | converts a 'Connect' frame into a 'Connected' frame,
  --   negotiating heart-beats and version;
  --   parameters:
  --
  --   * server desc
  --
  --   * session id
  --
  --   * caller's bid for heart-beat 
  --
  --   * caller's supported versions
  --
  --   * the original 'Connect' frame
  ------------------------------------------------------------------------
  conToCond :: String -> String -> Heart -> [Version] -> Frame -> Maybe Frame
  conToCond :: String -> String -> Heart -> [Heart] -> Frame -> Maybe Frame
conToCond String
s String
i Heart
b [Heart]
vs Frame
f = case Frame -> FrameType
typeOf Frame
f of
                          FrameType
Connect ->
                            Frame -> Maybe Frame
forall a. a -> Maybe a
Just CondFrame :: String -> Heart -> Heart -> SrvDesc -> [Header] -> Frame
CondFrame {
                                   frmSes :: String
frmSes  = String
i,
                                   frmBeat :: Heart
frmBeat = Heart -> Heart -> Heart
negoBeat (Frame -> Heart
frmBeat Frame
f) Heart
b,
                                   frmVer :: Heart
frmVer  = [Heart] -> [Heart] -> Heart
negoVersion [Heart]
vs ([Heart] -> Heart) -> [Heart] -> Heart
forall a b. (a -> b) -> a -> b
$ Frame -> [Heart]
frmAcVer Frame
f,
                                   frmSrv :: SrvDesc
frmSrv  = String -> SrvDesc
strToSrv String
s,
                                   frmHdrs :: [Header]
frmHdrs = Frame -> [Header]
frmHdrs Frame
f
                                 }
                          FrameType
_ -> Maybe Frame
forall a. Maybe a
Nothing

  ------------------------------------------------------------------------
  -- | Compliance with protocol version
  ------------------------------------------------------------------------
  complies :: Version -> Frame -> Bool
  complies :: Heart -> Frame -> Bool
complies Heart
v Frame
f = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> [Header] -> Bool
forall a b. Eq a => a -> [(a, b)] -> Bool
`elm` [Header]
has) [String]
must 
    where must :: [String]
must = FrameType -> Heart -> [String]
getHdrs (Frame -> FrameType
typeOf Frame
f) Heart
v
          has :: [Header]
has  = Frame -> [Header]
toHeaders Frame
f [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++ Frame -> [Header]
frmHdrs Frame
f
          elm :: a -> [(a, b)] -> Bool
elm  a
h [(a, b)]
hs = case a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
h [(a, b)]
hs of
                        Maybe b
Nothing -> Bool
False
                        Just b
_  -> Bool
True

  ------------------------------------------------------------------------
  -- Compliance Test: Mandatory headers 
  ------------------------------------------------------------------------
  getHdrs :: FrameType -> Version -> [String]
  getHdrs :: FrameType -> Heart -> [String]
getHdrs FrameType
t Heart
v =
    case FrameType
t of

       -- CONNECT or STOMP
       -- ================
       -- REQUIRED: accept-version, host
       -- OPTIONAL: login, passcode, heart-beat
       --
       FrameType
Connect     -> case Heart
v of
                        (Int
1,Int
0) -> []
                        (Int
1,Int
1) -> [String
"host", String
"accept-version"]
                        (Int
1,Int
2) -> [String
"host", String
"accept-version"]
                        Heart
_     -> []
       FrameType
Stomp       -> case Heart
v of
                        (Int
1,Int
0) -> []
                        (Int
1,Int
1) -> [String
"host", String
"accept-version"]
                        (Int
1,Int
2) -> [String
"host", String
"accept-version"]
                        Heart
_     -> []
       -- CONNECTED
       -- =========
       -- REQUIRED: version
       -- OPTIONAL: session, server, heart-beat
       --
       FrameType
Connected   -> case Heart
v of
                        (Int
1,Int
0) -> [String
"session-id"]
                        (Int
1,Int
1) -> [String
"version"]
                        (Int
1,Int
2) -> [String
"version"]
                        Heart
_     -> []
       -- DISCONNECT
       -- ==========
       -- REQUIRED: none
       -- OPTIONAL: receipt
       --
       FrameType
Disconnect  -> []

       -- SUBSCRIBE
       -- =========
       -- REQUIRED: destination, id
       -- OPTIONAL: ack
       FrameType
Subscribe   -> case Heart
v of
                        (Int
1,Int
0) -> [String
"destination"]
                        (Int
1,Int
1) -> [String
"id", String
"destination"]
                        (Int
1,Int
2) -> [String
"id", String
"destination"]
                        Heart
_     -> []

       -- UNSUBSCRIBE
       -- ===========
       -- REQUIRED: id
       -- OPTIONAL: none
       --
       FrameType
Unsubscribe -> case Heart
v of 
                        (Int
1,Int
0) -> [String
"destination"] -- either dest or id
                        (Int
1,Int
1) -> [String
"id"] 
                        (Int
1,Int
2) -> [String
"id"] 
                        Heart
_     -> []
       -- SEND
       -- ====
       -- REQUIRED: destination
       -- OPTIONAL: transaction
       --
       FrameType
Send        -> case Heart
v of
                        (Int
1,Int
0) -> [String
"destination"]
                        (Int
1,Int
1) -> [String
"destination"]
                        (Int
1,Int
2) -> [String
"destination"]
                        Heart
_     -> []
  
       -- MESSAGE
       -- =======
       -- REQUIRED: destination, message-id, subscription
       -- OPTIONAL: ack
       --
       FrameType
Message     -> case Heart
v of
                        (Int
1,Int
0) -> [String
"message-id", String
"destination"]
                        (Int
1,Int
1) -> [String
"message-id", String
"subscription", String
"destination"]
                        (Int
1,Int
2) -> [String
"message-id", String
"subscription", String
"destination"]
                        Heart
_     -> []

       -- BEGIN or COMMIT or ABORT
       -- ========================
       -- REQUIRED: transaction
       -- OPTIONAL: none
       --
       FrameType
Begin       -> [String
"transaction"] 
       FrameType
Commit      -> [String
"transaction"] 
       FrameType
Abort       -> [String
"transaction"] 

       -- ACK or NACK
       -- ===========
       -- REQUIRED: id
       -- OPTIONAL: transaction
       --
       FrameType
Ack         -> case Heart
v of
                        (Int
1,Int
0) -> [String
"message-id"]
                        (Int
1,Int
1) -> [String
"message-id", String
"subscription"]
                        (Int
1,Int
2) -> [String
"id"]
                        Heart
_     -> []
       FrameType
Nack        -> case Heart
v of 
                        (Int
1,Int
1) -> [String
"message-id", String
"subscription"]
                        Heart
_     -> []
       -- ERROR
       -- =====
       -- REQUIRED: none
       -- OPTIONAL: message
       --
       FrameType
Error       -> [] 

       -- RECEIPT
       -- =======
       -- REQUIRED: receipt-id
       -- OPTIONAL: none
       --
       FrameType
Receipt     -> [String
"receipt-id"] 
       FrameType
HeartBeat   -> []