module Network.Mom.Stompl.Parser (
stompParser,
stompAtOnce)
where
import Data.Attoparsec.ByteString hiding (take, takeWhile, takeTill)
import qualified Data.Attoparsec.ByteString as A
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as U
import Data.Word
import Control.Applicative ((<|>), (<$>))
import Control.Monad (void)
import Network.Mom.Stompl.Frame
stompAtOnce :: B.ByteString -> Either String Frame
stompAtOnce :: ByteString -> Either String Frame
stompAtOnce = Parser Frame -> ByteString -> Either String Frame
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser Frame
stompParser
stompParser :: Parser Frame
stompParser :: Parser Frame
stompParser = do
String
t <- Parser String
msgType
case String
t of
String
"" -> Parser Frame
beat
String
"CONNECT" -> Parser Frame
connect
String
"STOMP" -> Parser Frame
stomp
String
"CONNECTED" -> Parser Frame
connected
String
"DISCONNECT" -> Parser Frame
disconnect
String
"SEND" -> Parser Frame
send
String
"SUBSCRIBE" -> Parser Frame
subscribe
String
"UNSUBSCRIBE" -> Parser Frame
usubscribe
String
"BEGIN" -> Parser Frame
begin
String
"COMMIT" -> Parser Frame
commit
String
"ABORT" -> Parser Frame
abort
String
"ACK" -> Parser Frame
ack
String
"NACK" -> Parser Frame
nack
String
"MESSAGE" -> Parser Frame
message
String
"RECEIPT" -> Parser Frame
receipt
String
"ERROR" -> Parser Frame
prsError
String
_ -> String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Frame) -> String -> Parser Frame
forall a b. (a -> b) -> a -> b
$ String
"Unknown message type: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
msgType :: Parser String
msgType :: Parser String
msgType = do
Parser ()
skipWhite
ByteString
t <- (Word8 -> Bool) -> Parser ByteString
A.takeTill (Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
cr, Word8
eol, Word8
spc])
Parser ()
skipWhite
Parser ()
terminal
String -> Parser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Parser String) -> String -> Parser String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
U.toString ByteString
t
beat :: Parser Frame
beat :: Parser Frame
beat = Frame -> Parser Frame
forall (m :: * -> *) a. Monad m => a -> m a
return Frame
mkBeat
send :: Parser Frame
send :: Parser Frame
send = ([Header] -> Int -> ByteString -> Either String Frame)
-> Parser Frame
bodyFrame [Header] -> Int -> ByteString -> Either String Frame
mkSndFrame
message :: Parser Frame
message :: Parser Frame
message = ([Header] -> Int -> ByteString -> Either String Frame)
-> Parser Frame
bodyFrame [Header] -> Int -> ByteString -> Either String Frame
mkMsgFrame
prsError :: Parser Frame
prsError :: Parser Frame
prsError = ([Header] -> Int -> ByteString -> Either String Frame)
-> Parser Frame
bodyFrame [Header] -> Int -> ByteString -> Either String Frame
mkErrFrame
connect :: Parser Frame
connect :: Parser Frame
connect = ([Header] -> Either String Frame) -> Parser Frame
connectFrame [Header] -> Either String Frame
mkConFrame
stomp :: Parser Frame
stomp :: Parser Frame
stomp = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkStmpFrame
connected :: Parser Frame
connected :: Parser Frame
connected = ([Header] -> Either String Frame) -> Parser Frame
connectFrame [Header] -> Either String Frame
mkCondFrame
disconnect :: Parser Frame
disconnect :: Parser Frame
disconnect = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkDisFrame
subscribe :: Parser Frame
subscribe :: Parser Frame
subscribe = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkSubFrame
usubscribe :: Parser Frame
usubscribe :: Parser Frame
usubscribe = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkUSubFrame
begin :: Parser Frame
begin :: Parser Frame
begin = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkBgnFrame
commit :: Parser Frame
commit :: Parser Frame
commit = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkCmtFrame
abort :: Parser Frame
abort :: Parser Frame
abort = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkAbrtFrame
ack :: Parser Frame
ack :: Parser Frame
ack = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkAckFrame
nack :: Parser Frame
nack :: Parser Frame
nack = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkNackFrame
receipt :: Parser Frame
receipt :: Parser Frame
receipt = ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mkRecFrame
bodyFrame :: ([Header] -> Int -> Body -> Either String Frame) -> Parser Frame
bodyFrame :: ([Header] -> Int -> ByteString -> Either String Frame)
-> Parser Frame
bodyFrame [Header] -> Int -> ByteString -> Either String Frame
mk = do
[Header]
hs <- Bool -> Parser [Header]
headers Bool
True
case [Header] -> Either String Int
getLen [Header]
hs of
Left String
e -> String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
Right Int
l -> do
ByteString
b <- Int -> Parser ByteString
body Int
l
case [Header] -> Int -> ByteString -> Either String Frame
mk [Header]
hs Int
l ByteString
b of
Left String
e -> String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
Right Frame
m -> Frame -> Parser Frame
forall (m :: * -> *) a. Monad m => a -> m a
return Frame
m
connectFrame :: ([Header] -> Either String Frame) -> Parser Frame
connectFrame :: ([Header] -> Either String Frame) -> Parser Frame
connectFrame [Header] -> Either String Frame
mk = do
[Header]
hs <- Bool -> Parser [Header]
headers Bool
False
Parser ()
ignoreBody
case [Header] -> Either String Frame
mk [Header]
hs of
Left String
e -> String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
Right Frame
m -> Frame -> Parser Frame
forall (m :: * -> *) a. Monad m => a -> m a
return Frame
m
genericFrame :: ([Header] -> Either String Frame) -> Parser Frame
genericFrame :: ([Header] -> Either String Frame) -> Parser Frame
genericFrame [Header] -> Either String Frame
mk = do
[Header]
hs <- Bool -> Parser [Header]
headers Bool
True
Parser ()
ignoreBody
case [Header] -> Either String Frame
mk [Header]
hs of
Left String
e -> String -> Parser Frame
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
Right Frame
m -> Frame -> Parser Frame
forall (m :: * -> *) a. Monad m => a -> m a
return Frame
m
headers :: Bool -> Parser [Header]
Bool
t = [Header] -> [Header]
forall a. [a] -> [a]
reverse ([Header] -> [Header]) -> Parser [Header] -> Parser [Header]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Header] -> Parser [Header]
headers' Bool
t []
headers' :: Bool -> [Header] -> Parser [Header]
Bool
t [Header]
hs = do
Parser ()
skipWhite
[Header] -> Parser [Header]
endHeaders [Header]
hs Parser [Header] -> Parser [Header] -> Parser [Header]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> [Header] -> Parser [Header]
getHeader Bool
t [Header]
hs
endHeaders :: [Header] -> Parser [Header]
[Header]
hs = do
Parser ()
terminal
[Header] -> Parser [Header]
forall (m :: * -> *) a. Monad m => a -> m a
return [Header]
hs
getHeader :: Bool -> [Header] -> Parser [Header]
Bool
t [Header]
hs = do
Header
h <- Bool -> Parser Header
header Bool
t
Bool -> [Header] -> Parser [Header]
headers' Bool
t (Header
hHeader -> [Header] -> [Header]
forall a. a -> [a] -> [a]
:[Header]
hs)
header :: Bool -> Parser Header
Bool
t = do
ByteString
k <- Bool -> [Word8] -> Parser ByteString
escText Bool
t [Word8
col]
Parser ()
keyValSep
ByteString
v <- Bool -> [Word8] -> Parser ByteString
escText Bool
t [Word8
cr, Word8
eol]
Parser ()
terminal
Header -> Parser Header
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
U.toString ByteString
k, ByteString -> String
U.toString ByteString
v)
keyValSep :: Parser ()
keyValSep :: Parser ()
keyValSep = Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ())
-> Parser ByteString Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ByteString Word8
word8 Word8
col
terminal :: Parser ()
terminal :: Parser ()
terminal = do
Word8
c <- Parser ByteString Word8
anyWord8
case Word8
c of
Word8
10 -> () -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Word8
13 -> Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ())
-> Parser ByteString Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ByteString Word8
word8 Word8
eol
Word8
_ -> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Expecting end-of-line: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c
body :: Int -> Parser B.ByteString
body :: Int -> Parser ByteString
body Int
l | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> Parser ByteString
eob ByteString
B.empty
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> Parser ByteString
A.take Int
l Parser ByteString
-> (ByteString -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Parser ByteString
eob
| Bool
otherwise = (Word8 -> Bool) -> Parser ByteString
A.takeTill (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nul) Parser ByteString
-> (ByteString -> Parser ByteString) -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Parser ByteString
eob
eob :: B.ByteString -> Parser B.ByteString
eob :: ByteString -> Parser ByteString
eob ByteString
b = Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Word8 -> Parser ByteString Word8
word8 Word8
nul) Parser () -> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
escText :: Bool -> [Word8] -> Parser B.ByteString
escText :: Bool -> [Word8] -> Parser ByteString
escText Bool
tt [Word8]
stps = ByteString -> Parser ByteString
go ByteString
B.empty
where go :: ByteString -> Parser ByteString
go ByteString
t = do
let stps' :: [Word8]
stps' | Bool
tt = Word8
escWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
stps
| Bool
otherwise = [Word8]
stps
ByteString
n <- (Word8 -> Bool) -> Parser ByteString
A.takeTill (Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
stps')
Maybe Word8
mbB <- Parser (Maybe Word8)
peekWord8
case Maybe Word8
mbB of
Maybe Word8
Nothing -> String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString) -> String -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ String
"end reached, expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
forall a. Show a => a -> String
show [Word8]
stps
Just Word8
b ->
if Word8
b Word8 -> [Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
stps then ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
t ByteString -> ByteString -> ByteString
>|< ByteString
n)
else do
Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
esc
Word8
x <- Parser ByteString Word8
anyWord8
Word8
c <- case Word8
x of
Word8
92 -> Word8 -> Parser ByteString Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
esc
Word8
99 -> Word8 -> Parser ByteString Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
col
Word8
110 -> Word8 -> Parser ByteString Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
eol
Word8
114 -> Word8 -> Parser ByteString Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
cr
Word8
_ -> String -> Parser ByteString Word8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString Word8)
-> String -> Parser ByteString Word8
forall a b. (a -> b) -> a -> b
$ String
"Unknown escape sequence: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
ByteString -> Parser ByteString
go (ByteString
t ByteString -> ByteString -> ByteString
>|< ByteString
n ByteString -> Word8 -> ByteString
|> Word8
c)
ignoreBody :: Parser ()
ignoreBody :: Parser ()
ignoreBody = do
ByteString
_ <- (Word8 -> Bool) -> Parser ByteString
A.takeTill (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nul)
Word8
_ <- Word8 -> Parser ByteString Word8
word8 Word8
nul
() -> Parser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
skipWhite :: Parser ()
skipWhite :: Parser ()
skipWhite = Parser ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString -> Parser ()) -> Parser ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser ByteString
A.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
spc)
nul, eol, cr, spc, col, esc, _c, _r, _n :: Word8
nul :: Word8
nul = Word8
0
eol :: Word8
eol = Word8
10
cr :: Word8
cr = Word8
13
spc :: Word8
spc = Word8
32
col :: Word8
col = Word8
58
esc :: Word8
esc = Word8
92
_c :: Word8
_c = Word8
99
_r :: Word8
_r = Word8
114
_n :: Word8
_n = Word8
110