module System.Nitro (
nitroRuntimeStart
, NitroSocket
, SocketOptions(..)
, defaultOpts
, bind
, connect
, withSocket
, close
, NitroFrame
, bstrToFrame
, frameToBstr
, recv
, send
, reply
, relayFw
, relayBk
, sub
, unsub
, pub
, fileno
, Flag(NoWait)
, NitroError(..)
) where
import Foreign.C.Types
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Storable
import Foreign.C.String
import qualified Foreign.Concurrent as FC
import Foreign.Marshal.Alloc
import Data.IORef
import Data.Bits
import qualified Data.ByteString as BS
import Data.ByteString.Internal
import Control.Monad (when)
import Control.Exception (bracket)
import System.IO (hPutStrLn, stderr)
type NitroFrame = ForeignPtr ()
type NitroFrameInternal = Ptr (())
type NitroSocket = Ptr (())
type NitroSockOpt = Ptr (())
nitroRuntimeStart :: IO ()
nitroRuntimeStart =
nitroRuntimeStart'_ >>= \res ->
return ()
nitroFrameNewCopy :: Ptr () -> CUInt -> IO (NitroFrameInternal)
nitroFrameNewCopy a1 a2 =
let {a1' = id a1} in
let {a2' = id a2} in
nitroFrameNewCopy'_ a1' a2' >>= \res ->
let {res' = id res} in
return (res')
nitroFrameData :: NitroFrameInternal -> IO (Ptr ())
nitroFrameData a1 =
let {a1' = id a1} in
nitroFrameData'_ a1' >>= \res ->
let {res' = id res} in
return (res')
nitroFrameSize :: NitroFrameInternal -> IO (CUInt)
nitroFrameSize a1 =
let {a1' = id a1} in
nitroFrameSize'_ a1' >>= \res ->
let {res' = id res} in
return (res')
nitroSocketBind :: String -> NitroSockOpt -> IO (NitroSocket)
nitroSocketBind a1 a2 =
withCString a1 $ \a1' ->
let {a2' = id a2} in
nitroSocketBind'_ a1' a2' >>= \res ->
let {res' = id res} in
return (res')
nitroSocketConnect :: String -> NitroSockOpt -> IO (NitroSocket)
nitroSocketConnect a1 a2 =
withCString a1 $ \a1' ->
let {a2' = id a2} in
nitroSocketConnect'_ a1' a2' >>= \res ->
let {res' = id res} in
return (res')
nitroSockoptNew :: IO (NitroSockOpt)
nitroSockoptNew =
nitroSockoptNew'_ >>= \res ->
let {res' = id res} in
return (res')
nitroSockoptSetHwm :: NitroSockOpt -> Int -> IO ()
nitroSockoptSetHwm a1 a2 =
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
nitroSockoptSetHwm'_ a1' a2' >>= \res ->
return ()
nitroSockoptSetWantEventfd :: NitroSockOpt -> Int -> IO ()
nitroSockoptSetWantEventfd a1 a2 =
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
nitroSockoptSetWantEventfd'_ a1' a2' >>= \res ->
return ()
nitroSocketClose :: NitroSocket -> IO ()
nitroSocketClose a1 =
let {a1' = id a1} in
nitroSocketClose'_ a1' >>= \res ->
return ()
nitroSend :: NitroFrameInternal -> NitroSocket -> Int -> IO (Int)
nitroSend a1 a2 a3 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = fromIntegral a3} in
nitroSend'_ a1' a2' a3' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroRecv :: NitroSocket -> Int -> IO (NitroFrameInternal)
nitroRecv a1 a2 =
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
nitroRecv'_ a1' a2' >>= \res ->
let {res' = id res} in
return (res')
nitroReply :: NitroFrameInternal -> NitroFrameInternal -> NitroSocket -> Int -> IO (Int)
nitroReply a1 a2 a3 a4 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
let {a4' = fromIntegral a4} in
nitroReply'_ a1' a2' a3' a4' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroRelayFw :: NitroFrameInternal -> NitroFrameInternal -> NitroSocket -> Int -> IO (Int)
nitroRelayFw a1 a2 a3 a4 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
let {a4' = fromIntegral a4} in
nitroRelayFw'_ a1' a2' a3' a4' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroRelayBk :: NitroFrameInternal -> NitroFrameInternal -> NitroSocket -> Int -> IO (Int)
nitroRelayBk a1 a2 a3 a4 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
let {a4' = fromIntegral a4} in
nitroRelayBk'_ a1' a2' a3' a4' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroSub :: NitroSocket -> Ptr CUChar -> CULong -> IO (Int)
nitroSub a1 a2 a3 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
nitroSub'_ a1' a2' a3' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroUnsub :: NitroSocket -> Ptr CUChar -> CULong -> IO (Int)
nitroUnsub a1 a2 a3 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
nitroUnsub'_ a1' a2' a3' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroPub :: NitroFrameInternal -> Ptr CUChar -> CULong -> NitroSocket -> Int -> IO (Int)
nitroPub a1 a2 a3 a4 a5 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
let {a4' = id a4} in
let {a5' = fromIntegral a5} in
nitroPub'_ a1' a2' a3' a4' a5' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroEventfd :: NitroSocket -> IO (Int)
nitroEventfd a1 =
let {a1' = id a1} in
nitroEventfd'_ a1' >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroFrameDestroy :: NitroFrameInternal -> IO ()
nitroFrameDestroy a1 =
let {a1' = id a1} in
nitroFrameDestroy'_ a1' >>= \res ->
return ()
data Flag = NoFlag
| Reuse
| NoWait
deriving (Show,Eq,Enum)
toflag :: Flag -> [Flag] -> Int
toflag baseFlag = fromIntegral . foldr ((.|.) . fromEnum) (fromEnum baseFlag)
data NitroError = NitroErrNone
| NitroErrErrno
| NitroErrAlreadyRunning
| NitroErrNotRunning
| NitroErrTcpLocNocolon
| NitroErrTcpLocBadport
| NitroErrTcpLocBadipv4
| NitroErrParseBadTransport
| NitroErrTcpBadAny
| NitroErrEagain
| NitroErrNoRecipient
| NitroErrEncrypt
| NitroErrDecrypt
| NitroErrInvalidClear
| NitroErrMaxFrameExceeded
| NitroErrBadProtocolVersion
| NitroErrDoubleHandshake
| NitroErrNoHandshake
| NitroErrBadSub
| NitroErrBadHandshake
| NitroErrInvalidCert
| NitroErrBadInprocOpt
| NitroErrBadSecure
| NitroErrInprocAlreadyBound
| NitroErrInprocNotBound
| NitroErrInprocNoConnections
| NitroErrSubAlready
| NitroErrSubMissing
deriving (Enum,Show,Eq)
nitroError :: IO (Int)
nitroError =
nitroError'_ >>= \res ->
let {res' = fromIntegral res} in
return (res')
nitroErrmsg :: Int -> IO (String)
nitroErrmsg a1 =
let {a1' = fromIntegral a1} in
nitroErrmsg'_ a1' >>= \res ->
peekCString res >>= \res' ->
return (res')
throwNitroError fname e = case e == (fromEnum NitroErrEagain) of
True -> error $ fname ++ ": " ++ "Nitro Empty"
False -> do
hPutStrLn stderr $ fname ++ ": nitro_error code: " ++ (show e)
msg <- nitroErrmsg e
error $ fname ++ ": " ++ msg
data SocketOptions = SocketOptions {
wantFd :: Bool
}
defaultOpts = SocketOptions {
wantFd = False
}
setWantFd :: NitroSockOpt -> Bool -> IO ()
setWantFd opt v =
nitroSockoptSetWantEventfd opt (if v then (1 :: Int) else (0 :: Int))
setHighWaterMark :: NitroSockOpt -> Int -> IO ()
setHighWaterMark opt hwm =
nitroSockoptSetHwm opt hwm
setSockOpts :: NitroSockOpt -> SocketOptions -> IO ()
setSockOpts opt setopts =
setWantFd opt (wantFd setopts)
newNitroSockOpt :: SocketOptions -> IO NitroSockOpt
newNitroSockOpt opts = do
newOpt <- nitroSockoptNew
when (newOpt == nullPtr) $ do
e <- nitroError
throwNitroError "connect" e
setSockOpts newOpt opts
return newOpt
bind :: String -> SocketOptions -> IO NitroSocket
bind location opts = do
bound <- nitroSocketBind location =<< newNitroSockOpt opts
when (bound == nullPtr) $ do
e <- nitroError
throwNitroError "connect" e
return bound
connect :: String -> SocketOptions -> IO NitroSocket
connect location opts = do
connected <- nitroSocketConnect location =<< newNitroSockOpt opts
when (connected == nullPtr) $ do
e <- nitroError
throwNitroError "connect" e
return connected
withSocket :: (IO NitroSocket) -> (NitroSocket -> IO a) -> IO a
withSocket create action = bracket create close action
close :: NitroSocket -> IO ()
close = nitroSocketClose
fileno :: NitroSocket -> IO Int
fileno = nitroEventfd
recv :: NitroSocket -> [Flag] -> IO NitroFrame
recv s flags = do
fr <- nitroRecv s (toflag NoFlag flags)
fp <- FC.newForeignPtr fr (nitroFrameDestroy fr)
when (fr == nullPtr) $ do
e <- nitroError
throwNitroError "recv" e
bstr <- frameToBstr fp
return fp
frameToBstr :: NitroFrame -> IO ByteString
frameToBstr fp =
withForeignPtr fp $ \fr -> do
data' <- nitroFrameData fr
size <- nitroFrameSize fr
fptr <- newForeignPtr_ (castPtr data')
return $ BS.copy (PS fptr 0 (fromIntegral size))
send :: NitroSocket -> NitroFrame -> [Flag] -> IO ()
send s fp flags = do
withForeignPtr fp $ \fr -> do
e <- nitroSend fr s (toflag Reuse flags)
when (e < 0) $ do
e <- nitroError
throwNitroError "send" e
bstrToFrame :: ByteString -> IO NitroFrame
bstrToFrame (PS ps off size) = do
fr <- withForeignPtr ps $ \p -> nitroFrameNewCopy (castPtr p `plusPtr` off) (fromIntegral size)
FC.newForeignPtr fr (nitroFrameDestroy fr)
reply :: NitroSocket -> NitroFrame -> NitroFrame -> [Flag] -> IO ()
reply s snd fr flags =
withForeignPtr snd $ \ptr1 ->
withForeignPtr fr $ \ptr2 -> do
e <- nitroReply ptr1 ptr2 s (toflag Reuse flags)
when (e < 0) $ do
e <- nitroError
throwNitroError "reply" e
relayFw :: NitroSocket -> NitroFrame -> NitroFrame -> [Flag] -> IO ()
relayFw s snd fr flags = do
withForeignPtr snd $ \ptr1 ->
withForeignPtr fr $ \ptr2 -> do
e <- nitroRelayFw ptr1 ptr2 s (toflag Reuse flags)
when (e < 0) $ do
e <- nitroError
throwNitroError "relayFw" e
relayBk :: NitroSocket -> NitroFrame -> NitroFrame -> [Flag] -> IO ()
relayBk s snd fr flags = do
withForeignPtr snd $ \ptr1 ->
withForeignPtr fr $ \ptr2 -> do
e <- nitroRelayBk ptr1 ptr2 s (toflag Reuse flags)
when (e < 0) $ do
e <- nitroError
throwNitroError "relayBk" e
sub :: NitroSocket -> ByteString -> IO ()
sub s (PS key off size) = do
e <- withForeignPtr key $ \k -> nitroSub s (castPtr k `plusPtr` off) (fromIntegral size)
when (e < 0) $ do
e <- nitroError
throwNitroError "sub" e
unsub :: NitroSocket -> ByteString -> IO ()
unsub s (PS key off size) = do
e <- withForeignPtr key $ \k -> nitroSub s (castPtr k `plusPtr` off) (fromIntegral size)
when (e < 0) $ do
e <- nitroError
throwNitroError "unsub" e
pub :: NitroSocket -> NitroFrame -> ByteString -> [Flag] -> IO Int
pub s fp (PS key offk sizek) flags = do
withForeignPtr fp $ \fr ->
withForeignPtr key $ \k -> nitroPub fr (castPtr k `plusPtr` offk) (fromIntegral sizek) s (toflag Reuse flags)
foreign import ccall safe "System/Nitro.chs.h nitro_runtime_start"
nitroRuntimeStart'_ :: (IO CInt)
foreign import ccall safe "System/Nitro.chs.h nitro_frame_new_copy"
nitroFrameNewCopy'_ :: ((Ptr ()) -> (CUInt -> (IO (NitroFrameInternal))))
foreign import ccall safe "System/Nitro.chs.h nitro_frame_data"
nitroFrameData'_ :: ((NitroFrameInternal) -> (IO (Ptr ())))
foreign import ccall safe "System/Nitro.chs.h nitro_frame_size"
nitroFrameSize'_ :: ((NitroFrameInternal) -> (IO CUInt))
foreign import ccall safe "System/Nitro.chs.h nitro_socket_bind"
nitroSocketBind'_ :: ((Ptr CChar) -> ((NitroSockOpt) -> (IO (NitroSocket))))
foreign import ccall safe "System/Nitro.chs.h nitro_socket_connect"
nitroSocketConnect'_ :: ((Ptr CChar) -> ((NitroSockOpt) -> (IO (NitroSocket))))
foreign import ccall safe "System/Nitro.chs.h nitro_sockopt_new"
nitroSockoptNew'_ :: (IO (NitroSockOpt))
foreign import ccall safe "System/Nitro.chs.h nitro_sockopt_set_hwm"
nitroSockoptSetHwm'_ :: ((NitroSockOpt) -> (CInt -> (IO ())))
foreign import ccall safe "System/Nitro.chs.h nitro_sockopt_set_want_eventfd"
nitroSockoptSetWantEventfd'_ :: ((NitroSockOpt) -> (CInt -> (IO ())))
foreign import ccall safe "System/Nitro.chs.h nitro_socket_close"
nitroSocketClose'_ :: ((NitroSocket) -> (IO ()))
foreign import ccall safe "System/Nitro.chs.h nitro_send_"
nitroSend'_ :: ((NitroFrameInternal) -> ((NitroSocket) -> (CInt -> (IO CInt))))
foreign import ccall safe "System/Nitro.chs.h nitro_recv_"
nitroRecv'_ :: ((NitroSocket) -> (CInt -> (IO (NitroFrameInternal))))
foreign import ccall safe "System/Nitro.chs.h nitro_reply_"
nitroReply'_ :: ((NitroFrameInternal) -> ((NitroFrameInternal) -> ((NitroSocket) -> (CInt -> (IO CInt)))))
foreign import ccall safe "System/Nitro.chs.h nitro_relay_fw_"
nitroRelayFw'_ :: ((NitroFrameInternal) -> ((NitroFrameInternal) -> ((NitroSocket) -> (CInt -> (IO CInt)))))
foreign import ccall safe "System/Nitro.chs.h nitro_relay_bk_"
nitroRelayBk'_ :: ((NitroFrameInternal) -> ((NitroFrameInternal) -> ((NitroSocket) -> (CInt -> (IO CInt)))))
foreign import ccall safe "System/Nitro.chs.h nitro_sub_"
nitroSub'_ :: ((NitroSocket) -> ((Ptr CUChar) -> (CULong -> (IO CInt))))
foreign import ccall safe "System/Nitro.chs.h nitro_unsub_"
nitroUnsub'_ :: ((NitroSocket) -> ((Ptr CUChar) -> (CULong -> (IO CInt))))
foreign import ccall safe "System/Nitro.chs.h nitro_pub_"
nitroPub'_ :: ((NitroFrameInternal) -> ((Ptr CUChar) -> (CULong -> ((NitroSocket) -> (CInt -> (IO CInt))))))
foreign import ccall safe "System/Nitro.chs.h nitro_eventfd_"
nitroEventfd'_ :: ((NitroSocket) -> (IO CInt))
foreign import ccall safe "System/Nitro.chs.h nitro_frame_destroy_"
nitroFrameDestroy'_ :: ((NitroFrameInternal) -> (IO ()))
foreign import ccall safe "System/Nitro.chs.h nitro_error"
nitroError'_ :: (IO CInt)
foreign import ccall safe "System/Nitro.chs.h nitro_errmsg"
nitroErrmsg'_ :: (CInt -> (IO (Ptr CChar)))