{-# LANGUAGE OverloadedStrings #-}
module Network.RELP.Server
(
RelpMessageHandler
, runRelpServer
)
where
import Prelude hiding (getContents, take)
import Network.Socket hiding (send, recv)
import Network.Socket.ByteString.Lazy
import Control.Concurrent (forkIO)
import Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString.Lazy as LBP
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import Data.ByteString.UTF8 (toString)
import Data.Char
import Data.List (lookup)
import Control.Applicative
import Control.Monad
import qualified Control.Exception as E
import Control.Concurrent (forkFinally)
type RelpMessageHandler =
SockAddr
-> ByteString
-> IO Bool
data RelpCommand = RelpRSP | RelpOPEN | RelpSYSLOG | RelpCLOSE
| RelpCommand ByteString
deriving (Int -> RelpCommand -> ShowS
[RelpCommand] -> ShowS
RelpCommand -> [Char]
(Int -> RelpCommand -> ShowS)
-> (RelpCommand -> [Char])
-> ([RelpCommand] -> ShowS)
-> Show RelpCommand
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelpCommand -> ShowS
showsPrec :: Int -> RelpCommand -> ShowS
$cshow :: RelpCommand -> [Char]
show :: RelpCommand -> [Char]
$cshowList :: [RelpCommand] -> ShowS
showList :: [RelpCommand] -> ShowS
Show, RelpCommand -> RelpCommand -> Bool
(RelpCommand -> RelpCommand -> Bool)
-> (RelpCommand -> RelpCommand -> Bool) -> Eq RelpCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelpCommand -> RelpCommand -> Bool
== :: RelpCommand -> RelpCommand -> Bool
$c/= :: RelpCommand -> RelpCommand -> Bool
/= :: RelpCommand -> RelpCommand -> Bool
Eq)
data RelpMessage = RelpMessage
{ RelpMessage -> Int
relpTxnr :: Int
, RelpMessage -> RelpCommand
relpCommand :: RelpCommand
, RelpMessage -> ByteString
relpData :: ByteString
} deriving (Int -> RelpMessage -> ShowS
[RelpMessage] -> ShowS
RelpMessage -> [Char]
(Int -> RelpMessage -> ShowS)
-> (RelpMessage -> [Char])
-> ([RelpMessage] -> ShowS)
-> Show RelpMessage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelpMessage -> ShowS
showsPrec :: Int -> RelpMessage -> ShowS
$cshow :: RelpMessage -> [Char]
show :: RelpMessage -> [Char]
$cshowList :: [RelpMessage] -> ShowS
showList :: [RelpMessage] -> ShowS
Show, RelpMessage -> RelpMessage -> Bool
(RelpMessage -> RelpMessage -> Bool)
-> (RelpMessage -> RelpMessage -> Bool) -> Eq RelpMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelpMessage -> RelpMessage -> Bool
== :: RelpMessage -> RelpMessage -> Bool
$c/= :: RelpMessage -> RelpMessage -> Bool
/= :: RelpMessage -> RelpMessage -> Bool
Eq)
type RelpOffers = [(ByteString, ByteString)]
runRelpServer :: PortNumber
-> RelpMessageHandler
-> IO ()
runRelpServer :: PortNumber -> RelpMessageHandler -> IO ()
runRelpServer PortNumber
port RelpMessageHandler
cb = Maybe [Char] -> PortNumber -> (Socket -> IO ()) -> IO ()
forall a. Maybe [Char] -> PortNumber -> (Socket -> IO a) -> IO a
runTCPServer Maybe [Char]
forall a. Maybe a
Nothing PortNumber
port Socket -> IO ()
forall {b}. Socket -> IO b
handleConnection where
handleConnection :: Socket -> IO b
handleConnection Socket
sock = do
Socket -> IO (Socket, SockAddr)
accept Socket
sock IO (Socket, SockAddr)
-> ((Socket, SockAddr) -> IO ThreadId) -> IO ThreadId
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> ((Socket, SockAddr) -> IO ())
-> (Socket, SockAddr)
-> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, SockAddr) -> IO ()
handleMessage
Socket -> IO b
handleConnection Socket
sock
handleMessage :: (Socket, SockAddr) -> IO ()
handleMessage s :: (Socket, SockAddr)
s@(Socket
sockh, SockAddr
srcAddr) = do
Bool
status <- Socket -> IO ByteString
getContents Socket
sockh IO ByteString -> (ByteString -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Socket, SockAddr) -> ByteString -> IO Bool
processMessage (Socket, SockAddr)
s
if Bool
status then (Socket, SockAddr) -> IO ()
handleMessage (Socket, SockAddr)
s
else Socket -> IO ()
close Socket
sockh
processMessage :: (Socket, SockAddr) -> ByteString -> IO Bool
processMessage (Socket
sock, SockAddr
srcAddr) = ([Char] -> IO Bool)
-> (RelpMessage -> IO Bool)
-> Parser RelpMessage
-> ByteString
-> IO Bool
forall {c} {b}.
([Char] -> c) -> (b -> c) -> Parser b -> ByteString -> c
parseLazy_ [Char] -> IO Bool
forall {a}. Show a => a -> IO Bool
err RelpMessage -> IO Bool
process Parser RelpMessage
relpParser
where
err :: a -> IO Bool
err a
e = [Char] -> IO ()
putStrLn ([Char]
"ERROR: parser: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
e) IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
process :: RelpMessage -> IO Bool
process msg :: RelpMessage
msg@RelpMessage{ relpCommand :: RelpMessage -> RelpCommand
relpCommand = RelpCommand
RelpOPEN } = do
let offers :: [(ByteString, ByteString)]
offers = ([Char] -> [(ByteString, ByteString)])
-> ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> Parser [(ByteString, ByteString)]
-> ByteString
-> [(ByteString, ByteString)]
forall {c} {b}.
([Char] -> c) -> (b -> c) -> Parser b -> ByteString -> c
parse_ ([(ByteString, ByteString)] -> [Char] -> [(ByteString, ByteString)]
forall a b. a -> b -> a
const []) [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> a
id Parser [(ByteString, ByteString)]
relpOffersParser (ByteString -> [(ByteString, ByteString)])
-> ByteString -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ RelpMessage -> ByteString
relpData RelpMessage
msg
let versionValid :: Bool
versionValid = Bool -> (ByteString -> Bool) -> Maybe ByteString -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"0") (Maybe ByteString -> Bool) -> Maybe ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"relp_version" [(ByteString, ByteString)]
offers
if Bool
versionValid then do
Socket -> RelpMessage -> [Char] -> IO ()
relpRsp Socket
sock RelpMessage
msg ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"200 OK "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"relp_version=0\nrelp_software=hsRELP\ncommands="
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Char] -> (ByteString -> [Char]) -> Maybe ByteString -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"syslog" ByteString -> [Char]
toString (Maybe ByteString -> [Char]) -> Maybe ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"commands" [(ByteString, ByteString)]
offers)
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Socket -> RelpMessage -> [Char] -> IO ()
relpNAck Socket
sock RelpMessage
msg [Char]
"unsupported RELP version" IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
process msg :: RelpMessage
msg@RelpMessage{ relpCommand :: RelpMessage -> RelpCommand
relpCommand = RelpCommand
RelpSYSLOG } = do
Bool
status <- RelpMessageHandler
cb SockAddr
srcAddr (RelpMessage -> ByteString
relpData RelpMessage
msg)
if Bool
status then Socket -> RelpMessage -> IO ()
relpAck Socket
sock RelpMessage
msg else Socket -> RelpMessage -> [Char] -> IO ()
relpNAck Socket
sock RelpMessage
msg [Char]
"rejected"
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
status
process RelpMessage
msg = do
[Char] -> IO ()
putStrLn ([Char]
"ERROR: strange message command: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ RelpMessage -> [Char]
forall a. Show a => a -> [Char]
show RelpMessage
msg)
Socket -> RelpMessage -> [Char] -> IO ()
relpNAck Socket
sock RelpMessage
msg [Char]
"unexpected message command"
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
runTCPServer :: Maybe HostName -> PortNumber -> (Socket -> IO a) -> IO a
runTCPServer :: forall a. Maybe [Char] -> PortNumber -> (Socket -> IO a) -> IO a
runTCPServer Maybe [Char]
mhost PortNumber
port Socket -> IO a
server = IO a -> IO a
forall a. IO a -> IO a
withSocketsDo (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
AddrInfo
addr <- IO AddrInfo
resolve
IO Socket -> (Socket -> IO ()) -> (Socket -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (AddrInfo -> IO Socket
open AddrInfo
addr) Socket -> IO ()
close Socket -> IO a
forall {b}. Socket -> IO b
loop
where
resolve :: IO AddrInfo
resolve = do
let hints :: AddrInfo
hints = AddrInfo
defaultHints {
addrFlags = [AI_PASSIVE]
, addrSocketType = Stream
}
[AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head ([AddrInfo] -> AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo -> Maybe [Char] -> Maybe [Char] -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) Maybe [Char]
mhost ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ PortNumber -> [Char]
forall a. Show a => a -> [Char]
show PortNumber
port)
open :: AddrInfo -> IO Socket
open AddrInfo
addr = IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (AddrInfo -> IO Socket
openSocket AddrInfo
addr) Socket -> IO ()
close ((Socket -> IO Socket) -> IO Socket)
-> (Socket -> IO Socket) -> IO Socket
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
ReuseAddr Int
1
Socket -> (CInt -> IO ()) -> IO ()
forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
sock CInt -> IO ()
setCloseOnExecIfNeeded
Socket -> SockAddr -> IO ()
bind Socket
sock (SockAddr -> IO ()) -> SockAddr -> IO ()
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
addrAddress AddrInfo
addr
Socket -> Int -> IO ()
listen Socket
sock Int
1024
Socket -> IO Socket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
loop :: Socket -> IO b
loop Socket
sock = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ IO (Socket, SockAddr)
-> ((Socket, SockAddr) -> IO ())
-> ((Socket, SockAddr) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError (Socket -> IO (Socket, SockAddr)
accept Socket
sock) (Socket -> IO ()
close (Socket -> IO ())
-> ((Socket, SockAddr) -> Socket) -> (Socket, SockAddr) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst)
(((Socket, SockAddr) -> IO ()) -> IO ())
-> ((Socket, SockAddr) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Socket
conn, SockAddr
_peer) -> IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$
IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (Socket -> IO a
server Socket
conn) (IO () -> Either SomeException a -> IO ()
forall a b. a -> b -> a
const (IO () -> Either SomeException a -> IO ())
-> IO () -> Either SomeException a -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> Int -> IO ()
gracefulClose Socket
conn Int
5000)
relpParser :: Parser RelpMessage
relpParser :: Parser RelpMessage
relpParser = do
Int
txnr <- Parser Int
forall a. Integral a => Parser a
decimal Parser Int -> Parser ByteString Word8 -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Word8
space
RelpCommand
command <- Parser ByteString RelpCommand
parseCommand Parser ByteString RelpCommand
-> Parser ByteString Word8 -> Parser ByteString RelpCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Word8
space
Int
datalen <- Parser Int
forall a. Integral a => Parser a
decimal Parser Int -> Parser ByteString Word8 -> Parser Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Word8
space
ByteString
content <- Int -> Parser ByteString
take (Int
datalen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
RelpMessage -> Parser RelpMessage
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (RelpMessage -> Parser RelpMessage)
-> RelpMessage -> Parser RelpMessage
forall a b. (a -> b) -> a -> b
$ Int -> RelpCommand -> ByteString -> RelpMessage
RelpMessage Int
txnr RelpCommand
command ByteString
content
where
decimal :: Integral a => Parser a
decimal :: forall a. Integral a => Parser a
decimal = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' a -> Word8 -> a
forall {a} {a}. (Integral a, Num a) => a -> a -> a
step a
0 (ByteString -> a) -> Parser ByteString -> Parser ByteString a
forall a b. (a -> b) -> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Word8 -> Bool) -> Parser ByteString
takeWhile1 Word8 -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isDecimal where
step :: a -> a -> a
step a
a a
c = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
c a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
isDecimal :: a -> Bool
isDecimal a
c = a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
48 Bool -> Bool -> Bool
&& a
c a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
57
space :: Parser ByteString Word8
space = Word8 -> Parser ByteString Word8
word8 Word8
32
trailer :: Parser ByteString Word8
trailer = Word8 -> Parser ByteString Word8
word8 Word8
10
parseCommand :: Parser ByteString RelpCommand
parseCommand =
ByteString -> Parser ByteString
string ByteString
"syslog" Parser ByteString
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RelpCommand -> Parser ByteString RelpCommand
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return RelpCommand
RelpSYSLOG
Parser ByteString RelpCommand
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
string ByteString
"close" Parser ByteString
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RelpCommand -> Parser ByteString RelpCommand
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return RelpCommand
RelpCLOSE
Parser ByteString RelpCommand
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
string ByteString
"open" Parser ByteString
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RelpCommand -> Parser ByteString RelpCommand
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return RelpCommand
RelpOPEN
Parser ByteString RelpCommand
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
string ByteString
"rsp" Parser ByteString
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RelpCommand -> Parser ByteString RelpCommand
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return RelpCommand
RelpRSP
Parser ByteString RelpCommand
-> Parser ByteString RelpCommand -> Parser ByteString RelpCommand
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> RelpCommand
RelpCommand (ByteString -> RelpCommand)
-> Parser ByteString -> Parser ByteString RelpCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString
takeWhile1 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
32)
relpOffersParser :: Parser RelpOffers
relpOffersParser :: Parser [(ByteString, ByteString)]
relpOffersParser = Parser ByteString (ByteString, ByteString)
-> Parser [(ByteString, ByteString)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser ByteString (ByteString, ByteString)
-> Parser [(ByteString, ByteString)])
-> Parser ByteString (ByteString, ByteString)
-> Parser [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Parser ByteString (ByteString, ByteString)
pair Parser ByteString (ByteString, ByteString)
-> Parser ByteString Word8
-> Parser ByteString (ByteString, ByteString)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser ByteString Word8
word8 Word8
sep
where
sep :: Word8
sep = Word8
10
der :: Word8
der = Word8
61
pair :: Parser ByteString (ByteString, ByteString)
pair = (ByteString -> ByteString -> (ByteString, ByteString))
-> Parser ByteString
-> Parser ByteString
-> Parser ByteString (ByteString, ByteString)
forall a b c.
(a -> b -> c)
-> Parser ByteString a
-> Parser ByteString b
-> Parser ByteString c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
((Word8 -> Bool) -> Parser ByteString
takeWhile1 (\Word8
c-> Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
der Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
sep))
(Word8 -> Parser ByteString Word8
word8 Word8
der Parser ByteString Word8 -> Parser ByteString -> Parser ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString
takeWhile1 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
sep) Parser ByteString -> Parser ByteString -> Parser ByteString
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
"")
relpRsp :: Socket -> RelpMessage -> String -> IO ()
relpRsp :: Socket -> RelpMessage -> [Char] -> IO ()
relpRsp Socket
sock RelpMessage
msg [Char]
reply = Socket -> ByteString -> IO ()
sendAll Socket
sock ByteString
mkReply
where
mkReply :: ByteString
mkReply = [Char] -> ByteString
B8.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ RelpMessage -> Int
relpTxnr RelpMessage
msg) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" rsp "
[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
reply) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
reply [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
relpAck :: Socket -> RelpMessage -> IO ()
relpAck :: Socket -> RelpMessage -> IO ()
relpAck Socket
sock RelpMessage
msg = Socket -> RelpMessage -> [Char] -> IO ()
relpRsp Socket
sock RelpMessage
msg [Char]
"200 OK"
relpNAck :: Socket -> RelpMessage -> String -> IO ()
relpNAck :: Socket -> RelpMessage -> [Char] -> IO ()
relpNAck Socket
sock RelpMessage
msg [Char]
err = Socket -> RelpMessage -> [Char] -> IO ()
relpRsp Socket
sock RelpMessage
msg ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"500 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err
parse_ :: ([Char] -> c) -> (b -> c) -> Parser b -> ByteString -> c
parse_ [Char] -> c
err b -> c
ok Parser b
p = ([Char] -> c) -> (b -> c) -> Either [Char] b -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> c
err b -> c
ok (Either [Char] b -> c)
-> (ByteString -> Either [Char] b) -> ByteString -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser b -> ByteString -> Either [Char] b
forall a. Parser a -> ByteString -> Either [Char] a
parseOnly Parser b
p
parseLazy_ :: ([Char] -> c) -> (b -> c) -> Parser b -> ByteString -> c
parseLazy_ [Char] -> c
err b -> c
ok Parser b
p = ([Char] -> c) -> (b -> c) -> Either [Char] b -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> c
err b -> c
ok (Either [Char] b -> c)
-> (ByteString -> Either [Char] b) -> ByteString -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result b -> Either [Char] b
forall r. Result r -> Either [Char] r
LBP.eitherResult (Result b -> Either [Char] b)
-> (ByteString -> Result b) -> ByteString -> Either [Char] b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser b -> ByteString -> Result b
forall a. Parser a -> ByteString -> Result a
LBP.parse Parser b
p