module Network.Mom.Stompl.Frame (
Frame, FrameType(..),
Header, Body, Heart, Version,
AckMode(..), isValidAck,
SrvDesc,
getSrvName, getSrvVer, getSrvCmts,
mkConnect, mkStomp, mkConnected,
mkSubscribe, mkUnsubscribe,
mkSend, mkMessage, mkErr,
mkBegin, mkCommit, mkAbort,
mkAck, mkNack,
mkDisconnect,
mkBeat, mkReceipt,
mkConFrame, mkStmpFrame, mkCondFrame, mkDisFrame,
mkSubFrame, mkUSubFrame,
mkSndFrame, mkMsgFrame, mkErrFrame,
mkBgnFrame, mkCmtFrame, mkAbrtFrame,
mkAckFrame, mkNackFrame, mkRecFrame,
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,
typeOf, putFrame, toString, putCommand,
sndToMsg, conToCond,
resetTrans,
complies,
getDest, getTrans, getReceipt,
getLogin, getPasscode, getCliId,
getHost, getVersions, getVersion,
getBeat,
getSession, getServer,
getSub, getSelector, getId, getAcknow, getMsgAck,
getBody, getMime, getLength,
getMsg, getHeaders,
(|>), (<|), (>|<),
upString, numeric)
where
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
type = (String, String)
type Body = B.ByteString
type Version = (Int, Int)
type Heart = (Int, Int)
type SrvDesc = (String, String, String)
getSrvName :: SrvDesc -> String
getSrvName :: SrvDesc -> String
getSrvName (String
n, String
_, String
_) = String
n
getSrvVer :: SrvDesc -> String
getSrvVer :: SrvDesc -> String
getSrvVer (String
_, String
v, String
_) = String
v
getSrvCmts :: SrvDesc -> String
getSrvCmts :: SrvDesc -> String
getSrvCmts (String
_, String
_, String
c) = String
c
noBeat :: Heart
noBeat :: Heart
noBeat = (Int
0,Int
0)
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
String
k String
v = (String
k, String
v)
mkLogHdr :: String -> Header
mkPassHdr :: String -> Header
mkCliIdHdr :: String -> Header
mkDestHdr :: String -> Header
mkLenHdr :: String -> Header
mkMimeHdr :: String -> Header
mkTrnHdr :: String -> Header
mkRecHdr :: String -> Header
mkRecIdHdr :: String -> Header
mkSelHdr :: String -> Header
mkMIdHdr :: String -> Header
mkIdHdr :: String -> Header
mkSubHdr :: String -> Header
mkSrvHdr :: String -> Header
mkAckHdr :: String -> Header
mkSesHdr :: String -> Header
mkAcVerHdr :: String -> Header
mkVerHdr :: String -> Header
mkHostHdr :: String -> Header
mkMsgHdr :: String -> 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
data Frame = ConFrame {
Frame -> String
frmLogin :: String,
Frame -> String
frmPass :: String,
Frame -> String
frmHost :: String,
Frame -> Heart
frmBeat :: Heart,
Frame -> [Heart]
frmAcVer :: [Version],
Frame -> String
frmCliId :: String,
Frame -> [Header]
frmHdrs :: [Header]
}
| StompFrame {
frmLogin :: String,
frmPass :: String,
frmHost :: String,
frmBeat :: Heart,
frmAcVer :: [Version],
frmCliId :: String,
frmHdrs :: [Header]
}
| CondFrame {
Frame -> String
frmSes :: String,
frmBeat :: Heart,
Frame -> Heart
frmVer :: Version,
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)
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
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
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}
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}
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}
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}
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}
mkBegin :: String -> String -> [Header] -> Frame
mkBegin :: String -> String -> [Header] -> Frame
mkBegin = String -> String -> [Header] -> Frame
BgnFrame
mkCommit :: String -> String -> [Header] -> Frame
mkCommit :: String -> String -> [Header] -> Frame
mkCommit = String -> String -> [Header] -> Frame
CmtFrame
mkAbort :: String -> String -> [Header] -> Frame
mkAbort :: String -> String -> [Header] -> Frame
mkAbort = String -> String -> [Header] -> Frame
AbrtFrame
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}
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}
mkBeat :: Frame
mkBeat :: Frame
mkBeat = Frame
BeatFrame
mkDisconnect :: String -> [Header] -> Frame
mkDisconnect :: String -> [Header] -> Frame
mkDisconnect = String -> [Header] -> Frame
DisFrame
mkReceipt :: String -> [Header] -> Frame
mkReceipt :: String -> [Header] -> Frame
mkReceipt = String -> [Header] -> Frame
RecFrame
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}
getDest :: Frame -> String
getDest :: Frame -> String
getDest = Frame -> String
frmDest
getTrans :: Frame -> String
getTrans :: Frame -> String
getTrans = Frame -> String
frmTrans
getReceipt :: Frame -> String
getReceipt :: Frame -> String
getReceipt = Frame -> String
frmRec
getHost :: Frame -> String
getHost :: Frame -> String
getHost = Frame -> String
frmHost
getVersions :: Frame -> [Version]
getVersions :: Frame -> [Heart]
getVersions = Frame -> [Heart]
frmAcVer
getBeat :: Frame -> Heart
getBeat :: Frame -> Heart
getBeat = Frame -> Heart
frmBeat
getLogin :: Frame -> String
getLogin :: Frame -> String
getLogin = Frame -> String
frmLogin
getPasscode :: Frame -> String
getPasscode :: Frame -> String
getPasscode = Frame -> String
frmPass
getCliId :: Frame -> String
getCliId :: Frame -> String
getCliId = Frame -> String
frmCliId
getVersion :: Frame -> Version
getVersion :: Frame -> Heart
getVersion = Frame -> Heart
frmVer
getSession :: Frame -> String
getSession :: Frame -> String
getSession = Frame -> String
frmSes
getServer :: Frame -> SrvDesc
getServer :: Frame -> SrvDesc
getServer = Frame -> SrvDesc
frmSrv
getId :: Frame -> String
getId :: Frame -> String
getId = Frame -> String
frmId
getAcknow :: Frame -> AckMode
getAcknow :: Frame -> AckMode
getAcknow = Frame -> AckMode
frmAck
getSelector :: Frame -> String
getSelector :: Frame -> String
getSelector = Frame -> String
frmSel
getSub :: Frame -> String
getSub :: Frame -> String
getSub = Frame -> String
frmSub
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
getBody :: Frame -> B.ByteString
getBody :: Frame -> Body
getBody = Frame -> Body
frmBody
getMime :: Frame -> Mime.Type
getMime :: Frame -> Type
getMime = Frame -> Type
frmMime
getLength :: Frame -> Int
getLength :: Frame -> Int
getLength = Frame -> Int
frmLen
getMsg :: Frame -> String
getMsg :: Frame -> String
getMsg = Frame -> String
frmMsg
getHeaders :: Frame -> [Header]
= Frame -> [Header]
frmHdrs
data FrameType =
Connect
| Stomp
| Connected
| Disconnect
| Send
| Message
| Subscribe
| Unsubscribe
| Begin
| Commit
| Abort
| Ack
| Nack
| HeartBeat
| Error
| 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)
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
data AckMode =
Auto
| Client
| 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 >|<, |>, <|
(>|<) :: B.ByteString -> B.ByteString -> B.ByteString
(|>) :: B.ByteString -> Word8 -> B.ByteString
(<|) :: 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
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)
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
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
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
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
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
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
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
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
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
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
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
ackToVal :: AckMode -> String
ackToVal :: AckMode -> String
ackToVal = AckMode -> String
forall a. Show a => a -> String
show
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
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
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
resetTrans :: Frame -> Frame
resetTrans :: Frame -> Frame
resetTrans Frame
f = Frame
f {frmTrans :: String
frmTrans = String
""}
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
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
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
putHeaders :: Frame -> B.ByteString
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
putHeader :: Header -> B.ByteString
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]
toHeaders :: Frame -> [Header]
(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
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
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
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
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
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
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
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
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
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)
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)
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
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
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
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
normalise :: [Header] -> [Header]
normalise :: [Header] -> [Header]
normalise = [Header] -> [Header]
forall a. Eq a => [a] -> [a]
nub
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
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
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
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]
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]
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]
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
}
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}
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,
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]}
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 {
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]}
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]}
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]}
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]}
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]}
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)
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]
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}
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
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
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
getHdrs :: FrameType -> Version -> [String]
getHdrs :: FrameType -> Heart -> [String]
getHdrs FrameType
t Heart
v =
case FrameType
t of
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
_ -> []
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
_ -> []
FrameType
Disconnect -> []
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
_ -> []
FrameType
Unsubscribe -> case Heart
v of
(Int
1,Int
0) -> [String
"destination"]
(Int
1,Int
1) -> [String
"id"]
(Int
1,Int
2) -> [String
"id"]
Heart
_ -> []
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
_ -> []
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
_ -> []
FrameType
Begin -> [String
"transaction"]
FrameType
Commit -> [String
"transaction"]
FrameType
Abort -> [String
"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
_ -> []
FrameType
Error -> []
FrameType
Receipt -> [String
"receipt-id"]
FrameType
HeartBeat -> []