diff --git a/Network/Mom/Stompl/Frame.hs b/Network/Mom/Stompl/Frame.hs --- a/Network/Mom/Stompl/Frame.hs +++ b/Network/Mom/Stompl/Frame.hs @@ -20,7 +20,7 @@ -- $stomp_constructors -- ** Basic Frame Constructors - mkConnect, mkConnected, + mkConnect, mkStomp, mkConnected, mkSubscribe, mkUnsubscribe, mkSend, mkMessage, mkErr, mkBegin, mkCommit, mkAbort, @@ -28,7 +28,7 @@ mkDisconnect, mkBeat, mkReceipt, -- ** Header-based Frame Constructors - mkConFrame, mkCondFrame, mkDisFrame, + mkConFrame, mkStmpFrame, mkCondFrame, mkDisFrame, mkSubFrame, mkUSubFrame, mkSndFrame, mkMsgFrame, mkErrFrame, mkBgnFrame, mkCmtFrame, mkAbrtFrame, @@ -60,7 +60,7 @@ getHost, getVersions, getVersion, getBeat, getSession, getServer, - getSub, getSelector, getId, getAcknow, + getSub, getSelector, getId, getAcknow, getMsgAck, getBody, getMime, getLength, getMsg, getHeaders, -- * Sequence Operators to work on 'ByteString' @@ -154,7 +154,7 @@ noSrvDesc = ("","","") hdrLog, hdrPass, hdrDest, hdrSub, hdrLen, hdrTrn, hdrRec, hdrRecId, - hdrSel, hdrId, hdrAck, hdrSes, hdrMsg, hdrMId, hdrSrv, + hdrSel, hdrId, hdrAck, hdrAckId, hdrSes, hdrMsg, hdrMId, hdrSrv, hdrAcVer, hdrVer, hdrBeat, hdrHost, hdrMime, hdrCliId :: String hdrLog = "login" hdrPass = "passcode" @@ -169,6 +169,7 @@ hdrSel = "selector" hdrId = "id" hdrAck = "ack" + hdrAckId = "ack" hdrSes = "session-id" hdrMsg = "message" hdrMId = "message-id" @@ -307,14 +308,23 @@ frmPass :: String, frmHost :: String, frmBeat :: Heart, - frmAcVer :: [Version], -- 1.1 + frmAcVer :: [Version], -- 1.2 frmCliId :: String, frmHdrs :: [Header] } + | StompFrame { + frmLogin :: String, + frmPass :: String, + frmHost :: String, + frmBeat :: Heart, + frmAcVer :: [Version], -- 1.2 + frmCliId :: String, + frmHdrs :: [Header] + } | CondFrame { frmSes :: String, frmBeat :: Heart, - frmVer :: Version, -- 1.1 + frmVer :: Version, -- 1.2 frmSrv :: SrvDesc, frmHdrs :: [Header] } @@ -378,6 +388,7 @@ frmSub :: String, frmDest :: String, frmId :: String, + frmAckId :: String, frmLen :: Int, frmMime :: Mime.Type, frmBody :: Body} @@ -449,10 +460,26 @@ -- -- * 'Header': List of additional, broker-specific headers ---------------------------------------------------------------------- - mkConnect :: String -> String -> String -> Heart -> [Version] -> - String -> [Header] -> Frame - mkConnect usr pwd hst beat vers cli hs = - ConFrame { + mkConnect :: String -> String -> String -> + Heart -> [Version] -> String -> [Header] -> Frame + mkConnect = mkConStmp 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 = mkConStmp StompFrame + + mkConStmp :: (String -> String -> String -> + Heart -> [Version] -> String -> [Header] -> Frame) -> + String -> String -> String -> + Heart -> [Version] -> String -> [Header] -> Frame + mkConStmp mk usr pwd hst beat vers cli hs = + mk usr pwd hst beat vers cli hs + {- + mk { frmLogin = usr, frmPass = pwd, frmHost = hst, @@ -460,6 +487,7 @@ frmAcVer = vers, frmHdrs = hs, frmCliId = cli} + -} ---------------------------------------------------------------------- -- | make a 'Connect' frame (Broker -> Application). @@ -613,14 +641,15 @@ -- -- * 'Body': The payload ---------------------------------------------------------------------- - mkMessage :: String -> String -> String -> + mkMessage :: String -> String -> String -> String -> Mime.Type -> Int -> [Header] -> Body -> Frame - mkMessage sub dst mid mime len hs bdy = + mkMessage sub dst mid ack mime len hs bdy = MsgFrame { frmHdrs = hs, frmSub = sub, frmDest = dst, + frmAckId = ack, frmId = mid, frmLen = len, frmMime = mime, @@ -850,6 +879,12 @@ getSub :: Frame -> String getSub = frmSub ------------------------------------------------------------------------ + -- | get /ack/ or /message-id/ from 'Message' + ------------------------------------------------------------------------ + getMsgAck :: Frame -> String + getMsgAck f | null (frmAckId f) = frmId f + | otherwise = frmAckId f + ------------------------------------------------------------------------ -- | get /body/ from 'Send', 'Message', 'Error' ------------------------------------------------------------------------ getBody :: Frame -> B.ByteString @@ -888,6 +923,8 @@ 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 @@ -925,21 +962,22 @@ ------------------------------------------------------------------------ typeOf :: Frame -> FrameType typeOf f = case f of - ConFrame {} -> Connect - CondFrame {} -> Connected - DisFrame {} -> Disconnect - SubFrame {} -> Subscribe - USubFrame {} -> Unsubscribe - SndFrame {} -> Send - BgnFrame {} -> Begin - CmtFrame {} -> Commit - AbrtFrame {} -> Abort - AckFrame {} -> Ack - NackFrame {} -> Nack - MsgFrame {} -> Message - RecFrame {} -> Receipt - ErrFrame {} -> Error - BeatFrame {} -> HeartBeat + ConFrame {} -> Connect + StompFrame {} -> Stomp + CondFrame {} -> Connected + DisFrame {} -> Disconnect + SubFrame {} -> Subscribe + USubFrame {} -> Unsubscribe + SndFrame {} -> Send + BgnFrame {} -> Begin + CmtFrame {} -> Commit + AbrtFrame {} -> Abort + AckFrame {} -> Ack + NackFrame {} -> Nack + MsgFrame {} -> Message + RecFrame {} -> Receipt + ErrFrame {} -> Error + BeatFrame {} -> HeartBeat ------------------------------------------------------------------------ -- The AckMode of a Subscription @@ -978,9 +1016,9 @@ -- | append (>|<) :: B.ByteString -> B.ByteString -> B.ByteString -- | snoc - (|>) :: B.ByteString -> Char -> B.ByteString + (|>) :: B.ByteString -> Char -> B.ByteString -- | cons - (<|) :: Char -> B.ByteString -> B.ByteString + (<|) :: Char -> B.ByteString -> B.ByteString x >|< y = x `B.append` y x <| y = x `B.cons` y x |> y = x `B.snoc` y @@ -1169,6 +1207,7 @@ putCommand f = let s = case typeOf f of Connect -> "CONNECT" + Stomp -> "STOMP" Connected -> "CONNECTED" Disconnect -> "DISCONNECT" Send -> "SEND" @@ -1192,16 +1231,23 @@ putHeaders f = let hs = toHeaders f s = B.concat $ map putHeader hs - in s |> '\n' + in s |> '\n' ------------------------------------------------------------------------ -- Convert header to ByteString ------------------------------------------------------------------------ putHeader :: Header -> B.ByteString putHeader h = - let k = fst h - v = snd h + let k = esc $ fst h + v = esc $ snd h in U.fromString $ k ++ ":" ++ v ++ "\n" + where esc = foldl' (\l -> (++) l . conv) [] + conv c = case c of + '\n' -> "\\n" + '\r' -> "\\r" + '\\' -> "\\\\" + ':' -> "\\c" + _ -> [c] ------------------------------------------------------------------------ -- Convert Frame attributes to headers @@ -1215,6 +1261,13 @@ ih = if null i then [] else [mkCliIdHdr i] in normalise $ [mkAcVerHdr $ versToVal v, mkHostHdr h] ++ lh ++ ph ++ bh ++ ih ++ hs + toHeaders (StompFrame l p h b v i hs) = + let lh = if null l then [] else [mkLogHdr l] + ph = if null p then [] else [mkPassHdr p] + bh = if b == (0,0) then [] else [mkBeatHdr $ beatToVal b] + ih = if null i then [] else [mkCliIdHdr i] + in normalise $ [mkAcVerHdr $ versToVal v, + mkHostHdr h] ++ lh ++ ph ++ bh ++ ih ++ hs -- Connected Frame ----------------------------------------------------- toHeaders (CondFrame s b v d hs) = let sh = if s == "0" then [] else [mkSesHdr s] @@ -1258,19 +1311,20 @@ let rh = if null r then [] else [mkRecHdr r] in normalise $ [mkTrnHdr t] ++ rh ++ hs -- Ack Frame -------------------------------------------------------------- - toHeaders (AckFrame i s t r hs) = - normalise ([mkMIdHdr i] ++ hs ++ subRecTrn s r t) + toHeaders (AckFrame i s t r hs) = + normalise ([mkMIdHdr i, mkIdHdr i] ++ hs ++ subRecTrn s r t) -- Nack Frame ------------------------------------------------------------- toHeaders (NackFrame i s t r hs) = - normalise ([mkMIdHdr i] ++ hs ++ subRecTrn s r t) + normalise ([mkMIdHdr i, mkIdHdr i] ++ hs ++ subRecTrn s r t) -- Message Frame ---------------------------------------------------------- - toHeaders (MsgFrame hs s d i l m _) = + toHeaders (MsgFrame hs s d i a l m _) = let sh = if null s then [] else [mkSubHdr s] dh = if null d then [] else [mkDestHdr d] + ah = if null a then [] else [mkAckHdr a] lh = if l <= 0 then [] else [mkLenHdr (show l)] in normalise $ [mkMIdHdr i, mkMimeHdr (showType m)] - ++ sh ++ dh ++ lh ++ hs + ++ sh ++ dh ++ ah ++ lh ++ hs -- Receipt Frame ---------------------------------------------------------- toHeaders (RecFrame r hs) = normalise $ mkRecIdHdr r : hs -- Error Frame ------------------------------------------------------------ @@ -1316,7 +1370,18 @@ -- | make 'Connect' frame ------------------------------------------------------------------------ mkConFrame :: [Header] -> Either String Frame - mkConFrame hs = + mkConFrame = mkConTypeFrame ConFrame + + ------------------------------------------------------------------------ + -- | make 'Stomp' frame + ------------------------------------------------------------------------ + mkStmpFrame :: [Header] -> Either String Frame + mkStmpFrame = mkConTypeFrame StompFrame + + mkConTypeFrame :: (String -> String -> String -> + Heart -> [Version] -> String -> [Header] -> Frame) -> + [Header] -> Either String Frame + mkConTypeFrame mk hs = let l = findStrHdr hdrLog "" hs p = findStrHdr hdrPass "" hs h = findStrHdr hdrHost "" hs @@ -1336,8 +1401,8 @@ Left e -> Left e Right vs -> case eiB of - Left e -> Left e - Right b -> Right $ ConFrame l p h b vs i $ + Left e -> Left e + Right b -> Right $ mk l p h b vs i $ rmHdrs hs [hdrLog, hdrPass, hdrHost, hdrCliId] ------------------------------------------------------------------------ @@ -1401,17 +1466,18 @@ Nothing -> Left "No message id in MESSAGE Frame" Just i -> Right MsgFrame { - frmHdrs = rmHdrs hs [hdrSub, hdrMime, - hdrLen, hdrDest, - hdrMId], - frmDest = d, - frmSub = findStrHdr hdrSub "" hs, - frmId = i, - frmLen = l, - frmMime = case lookup hdrMime hs of - Nothing -> defMime - Just t -> - fromMaybe defMime (parseMIMEType t), + frmHdrs = rmHdrs hs [hdrSub, hdrMime, + hdrLen, hdrDest, + hdrMId, hdrAckId], + frmDest = d, + frmSub = findStrHdr hdrSub "" hs, + frmAckId = findStrHdr hdrAckId "" hs, + frmId = i, + frmLen = l, + frmMime = case lookup hdrMime hs of + Nothing -> defMime + Just t -> + fromMaybe defMime (parseMIMEType t), frmBody = b} ------------------------------------------------------------------------ @@ -1426,8 +1492,11 @@ Right a -> Right SubFrame { frmDest = d, frmAck = a, - frmSel = findStrHdr hdrSel "" hs, + -- id is mandatory, but we don't + -- penalise when it's missing + -- to maintain compatibility with 1.0 frmId = findStrHdr hdrId "" hs, + frmSel = findStrHdr hdrSel "" hs, frmRec = findStrHdr hdrRec "" hs, frmHdrs = rmHdrs hs [hdrDest, hdrAck, hdrSel, hdrId, @@ -1448,6 +1517,9 @@ frmRec = findStrHdr hdrRec "" hs, frmHdrs = rmHdrs hs [hdrId, hdrRec]} Just d -> Right USubFrame { + -- id is mandatory, but we don't + -- penalise when it's missing + -- to maintain compatibility with 1.0 frmId = findStrHdr hdrId "" hs, frmDest = d, frmRec = findStrHdr hdrRec "" hs, @@ -1494,33 +1566,46 @@ ------------------------------------------------------------------------ mkAckFrame :: [Header] -> Either String Frame mkAckFrame hs = - case lookup hdrMId hs of - Nothing -> Left "No message-id header in Ack Frame" - Just i -> let (t,s,r) = findSubRecTrn hs - in Right AckFrame { - frmId = i, - frmSub = s, - frmTrans = t, - frmRec = r, - frmHdrs = rmHdrs hs [hdrMId, hdrTrn, - hdrSub, hdrRec]} + let mbI = case lookup hdrId hs of + Nothing -> + case lookup hdrMId hs of + Nothing -> Nothing + Just i -> Just i + Just i -> Just i + (t,s,r) = findSubRecTrn hs + in case mbI of + Nothing -> Left "No id header in Ack Frame" + Just i -> Right AckFrame { + frmId = i, + frmSub = s, + frmTrans = t, + frmRec = r, + frmHdrs = rmHdrs hs [hdrMId, hdrId, hdrTrn, + hdrSub, hdrRec]} ------------------------------------------------------------------------ -- | make 'Nack' frame ------------------------------------------------------------------------ mkNackFrame :: [Header] -> Either String Frame mkNackFrame hs = - case lookup hdrMId hs of - Nothing -> Left "No message-id header in Ack Frame" - Just i -> let (t,s,r) = findSubRecTrn hs - in Right NackFrame { - frmId = i, - frmSub = s, - frmTrans = t, - frmRec = r, - frmHdrs = rmHdrs hs [hdrMId, hdrTrn, - hdrSub, hdrRec]} + let mbI = case lookup hdrId hs of + Nothing -> + case lookup hdrMId hs of + Nothing -> Nothing + Just i -> Just i + Just i -> Just i + (t,s,r) = findSubRecTrn hs + in case mbI of + Nothing -> Left "No id header in Ack Frame" + Just i -> Right NackFrame { + frmId = i, + frmSub = s, + frmTrans = t, + frmRec = r, + frmHdrs = rmHdrs hs [hdrMId, hdrId, hdrTrn, + hdrSub, hdrRec]} + findSubRecTrn :: [Header] -> (String, String, String) findSubRecTrn hs = let t = findStrHdr hdrTrn "" hs @@ -1563,19 +1648,20 @@ -- -- * The original 'Send' frame ------------------------------------------------------------------------ - sndToMsg :: String -> String -> Frame -> Maybe Frame - sndToMsg i sub f = case typeOf f of - Send -> - Just MsgFrame { - frmHdrs = frmHdrs f, - frmDest = frmDest f, - frmSub = sub, - frmLen = frmLen f, - frmMime = frmMime f, - frmId = i, - frmBody = frmBody f - } - _ -> Nothing + sndToMsg :: String -> String -> String -> Frame -> Maybe Frame + sndToMsg i sub a f = case typeOf f of + Send -> + Just MsgFrame { + frmHdrs = frmHdrs f, + frmDest = frmDest f, + frmSub = sub, + frmLen = frmLen f, + frmMime = frmMime f, + frmId = i, + frmAckId = a, + frmBody = frmBody f + } + _ -> Nothing ------------------------------------------------------------------------ -- | converts a 'Connect' frame into a 'Connected' frame, @@ -1616,47 +1702,120 @@ Just _ -> True ------------------------------------------------------------------------ - -- Mandatory headers + -- Compliance Test: Mandatory headers ------------------------------------------------------------------------ getHdrs :: FrameType -> Version -> [String] getHdrs t v = case t of + + -- CONNECT or STOMP + -- ================ + -- REQUIRED: accept-version, host + -- OPTIONAL: login, passcode, heart-beat + -- Connect -> case v of (1,0) -> [] (1,1) -> ["host", "accept-version"] + (1,2) -> ["host", "accept-version"] _ -> [] + Stomp -> case v of + (1,0) -> [] + (1,1) -> ["host", "accept-version"] + (1,2) -> ["host", "accept-version"] + _ -> [] + -- CONNECTED + -- ========= + -- REQUIRED: version + -- OPTIONAL: session, server, heart-beat + -- Connected -> case v of (1,0) -> ["session-id"] (1,1) -> ["version"] + (1,2) -> ["version"] _ -> [] + -- DISCONNECT + -- ========== + -- REQUIRED: none + -- OPTIONAL: receipt + -- Disconnect -> [] + + -- SUBSCRIBE + -- ========= + -- REQUIRED: destination, id + -- OPTIONAL: ack Subscribe -> case v of (1,0) -> ["destination"] (1,1) -> ["id", "destination"] + (1,2) -> ["id", "destination"] _ -> [] + + -- UNSUBSCRIBE + -- =========== + -- REQUIRED: id + -- OPTIONAL: none + -- Unsubscribe -> case v of (1,0) -> ["destination"] -- either dest or id (1,1) -> ["id"] + (1,2) -> ["id"] _ -> [] + -- SEND + -- ==== + -- REQUIRED: destination + -- OPTIONAL: transaction + -- Send -> case v of (1,0) -> ["destination"] (1,1) -> ["destination"] + (1,2) -> ["destination"] _ -> [] + + -- MESSAGE + -- ======= + -- REQUIRED: destination, message-id, subscription + -- OPTIONAL: ack + -- Message -> case v of (1,0) -> ["message-id", "destination"] (1,1) -> ["message-id", "subscription", "destination"] + (1,2) -> ["message-id", "subscription", "destination"] _ -> [] + + -- BEGIN or COMMIT or ABORT + -- ======================== + -- REQUIRED: transaction + -- OPTIONAL: none + -- Begin -> ["transaction"] Commit -> ["transaction"] Abort -> ["transaction"] + + -- ACK or NACK + -- =========== + -- REQUIRED: id + -- OPTIONAL: transaction + -- Ack -> case v of (1,0) -> ["message-id"] (1,1) -> ["message-id", "subscription"] + (1,2) -> ["id"] _ -> [] Nack -> case v of (1,1) -> ["message-id", "subscription"] _ -> [] + -- ERROR + -- ===== + -- REQUIRED: none + -- OPTIONAL: message + -- Error -> [] + + -- RECEIPT + -- ======= + -- REQUIRED: receipt-id + -- OPTIONAL: none + -- Receipt -> ["receipt-id"] HeartBeat -> [] diff --git a/Network/Mom/Stompl/Parser.hs b/Network/Mom/Stompl/Parser.hs --- a/Network/Mom/Stompl/Parser.hs +++ b/Network/Mom/Stompl/Parser.hs @@ -21,6 +21,7 @@ import Data.Word import Control.Applicative ((<|>), (<$>)) + import Control.Monad (void) import Network.Mom.Stompl.Frame ------------------------------------------------------------------------ @@ -39,7 +40,7 @@ case t of "" -> beat "CONNECT" -> connect - "STOMP" -> connect + "STOMP" -> stomp "CONNECTED" -> connected "DISCONNECT" -> disconnect "SEND" -> send @@ -58,7 +59,7 @@ msgType :: Parser String msgType = do skipWhite - t <- A.takeTill endAny + t <- A.takeTill (`elem` [cr, eol, spc]) skipWhite terminal return $ U.toString t @@ -75,22 +76,14 @@ prsError :: Parser Frame prsError = bodyFrame mkErrFrame - bodyFrame :: ([Header] -> Int -> Body -> Either String Frame) -> Parser Frame - bodyFrame mk = do - hs <- headers - case getLen hs of - Left e -> fail e - Right l -> do - b <- body l - case mk hs l b of - Left e -> fail e - Right m -> return m - connect :: Parser Frame - connect = genericFrame mkConFrame + connect = connectFrame mkConFrame + stomp :: Parser Frame + stomp = genericFrame mkStmpFrame + connected :: Parser Frame - connected = genericFrame mkCondFrame + connected = connectFrame mkCondFrame disconnect :: Parser Frame disconnect = genericFrame mkDisFrame @@ -119,52 +112,93 @@ receipt :: Parser Frame receipt = genericFrame mkRecFrame + ------------------------------------------------------------------------ + -- Frame with body + ------------------------------------------------------------------------ + bodyFrame :: ([Header] -> Int -> Body -> Either String Frame) -> Parser Frame + bodyFrame mk = do + hs <- headers True + case getLen hs of + Left e -> fail e + Right l -> do + b <- body l + case mk hs l b of + Left e -> fail e + Right m -> return m + + ------------------------------------------------------------------------ + -- Frame without body and without escaping headers, + -- i.e. connect and connected + ------------------------------------------------------------------------ + connectFrame :: ([Header] -> Either String Frame) -> Parser Frame + connectFrame mk = do + hs <- headers False + ignoreBody + case mk hs of + Left e -> fail e + Right m -> return m + + ------------------------------------------------------------------------ + -- Frame without body + ------------------------------------------------------------------------ genericFrame :: ([Header] -> Either String Frame) -> Parser Frame genericFrame mk = do - hs <- headers + hs <- headers True ignoreBody case mk hs of Left e -> fail e Right m -> return m - headers :: Parser [Header] - headers = reverse <$> headers' [] + ------------------------------------------------------------------------ + -- we add each next header found to the head of the list + -- of headers already parsed and therefore + -- reverse the list of all headers + ------------------------------------------------------------------------ + headers :: Bool -> Parser [Header] + headers t = reverse <$> headers' t [] - headers' :: [Header] -> Parser [Header] - headers' hs = do + headers' :: Bool -> [Header] -> Parser [Header] + headers' t hs = do skipWhite - endHeaders hs <|> getHeader hs + endHeaders hs <|> getHeader t hs endHeaders :: [Header] -> Parser [Header] endHeaders hs = do terminal return hs - getHeader :: [Header] -> Parser [Header] - getHeader hs = do - h <- header - headers' (h:hs) + getHeader :: Bool -> [Header] -> Parser [Header] + getHeader t hs = do + h <- header t + headers' t (h:hs) - header :: Parser Header - header = do - k <- A.takeTill endAny - keyValSep - v <- A.takeTill endLine + header :: Bool -> Parser Header + header t = do + k <- escText t [col] + keyValSep + v <- escText t [cr, eol] terminal return (U.toString k, U.toString v) keyValSep :: Parser () - keyValSep = do - skipWhite - _ <- takeWhile1 (== col) - skipWhite + keyValSep = void $ word8 col + ------------------------------------------------------------------------ + -- end-of-line: either lf or cr ++ lf + ------------------------------------------------------------------------ terminal :: Parser () terminal = do - -- skipWhite - _ <- word8 eol - return () + c <- anyWord8 + case c of + 10 -> return () + 13 -> void $ word8 eol + _ -> fail $ "Expecting end-of-line: " ++ show c + ------------------------------------------------------------------------ + -- read text until null or, + -- if text length is given, + -- until text length + ------------------------------------------------------------------------ body :: Int -> Parser B.ByteString body x = body' x B.empty where @@ -182,6 +216,33 @@ _ <- word8 nul body' l (b |> '\x00') + ------------------------------------------------------------------------ + -- escape header key and value; + -- we don't do this for connect and connected frames, + -- this is controlled by the Bool parameter. + ------------------------------------------------------------------------ + escText :: Bool -> [Word8] -> Parser B.ByteString + escText tt stps = go B.empty + where go t = do + let stps' | tt = esc:stps + | otherwise = stps + n <- A.takeTill (`elem` stps') + mbB <- peekWord8 + case mbB of + Nothing -> fail $ "end reached, expected: " ++ show stps + Just b -> + if b `elem` stps then return (t >|< n) + else do + _ <- word8 esc + x <- anyWord8 + c <- case x of + 92 -> return '\\' + 99 -> return ':' + 110 -> return '\n' + 114 -> return '\r' + _ -> fail $ "Unknown escape sequence: " ++ show x + go (t >|< n |> c) + ignoreBody :: Parser () ignoreBody = do _ <- A.takeTill (== nul) @@ -189,21 +250,18 @@ return () skipWhite :: Parser () - skipWhite = do - _ <- A.takeWhile (== spc) - return () - - endAny :: Word8 -> Bool - endAny w = w `elem` [col, eol, spc, nul] - - endLine :: Word8 -> Bool - endLine = (== eol) + skipWhite = void $ A.takeWhile (== spc) - nul, eol, spc, col :: Word8 - nul = 0 - eol = 10 - spc = 32 - col = 58 + nul, eol, cr, spc, col, esc, _c, _r, _n :: Word8 + nul = 0 + eol = 10 + cr = 13 + spc = 32 + col = 58 + esc = 92 + _c = 99 + _r = 114 + _n = 110 failBodyLen :: Int -> Int -> Parser a failBodyLen l1 l2 = diff --git a/stompl.cabal b/stompl.cabal --- a/stompl.cabal +++ b/stompl.cabal @@ -1,6 +1,6 @@ Name: stompl Category: Message-Oriented Middleware, Network, Stomp, Parser -Version: 0.0.3 +Version: 0.1.0 Cabal-Version: >= 1.8 Copyright: Copyright (c) Tobias Schoofs, 2011 - 2012 License: LGPL @@ -39,10 +39,69 @@ . + [0.1.0] Major changes: + + . + + - Compliance with Stomp 1.2: + + . + + - header keys and values are now escaped; + this, in fact, was missing for Stomp 1.1. + + . + + - header keys and values are not trimmed or padded; + this, as well, should have been done for Stomp 1.1 already. + Be aware that Stomp 1.0-like message headers + may fail now, /e.g./: + /message : hello world/ + is not the same anymore as + /message:hello world/ + + . + + - carriage return (ascii 13) plus line feed (ascii 10) + is now accepted as end-of-line; + note that stompl never generates carriage return as end-of-line, + the standard end-of-line remains line feed. + + . + + - the Message frame may have an /ack/ header + and should have when a message is sent + through a queue that requires explicit ack. + + . + + - the mandatory header in the Ack frame is now /id/ + instead of /message-id/. It should correspond to /ack/ + in the message that is ack'd. + Note that, to ease backward compatibility, + Ack frames are generated with both: + an /id/ and a /message-id/ header. + + . + + - a Stomp frame was added. + The Stomp frame has exactly the same format + as the Connect frame, but it is handled differently + with respect to escaping: Connect header keys and values + are not escaped, Stomp header keys and values, however, are. + + . + [0.0.3] Major changes: - New attribute "ClientId" in Connect frame + + . + + - new attribute "ClientId" in Connect frame for compatibility with ActiveMQ; - all commands accept additional headers + + . + + - all commands accept additional headers to ease adaptations to broker-specific features. .