{--*-Mode:haskell;coding:utf-8;tab-width:4;c-basic-offset:4;indent-tabs-mode:()-*-
  ex: set ft=haskell fenc=utf-8 sts=4 ts=4 sw=4 et nomod: -}

{-

  MIT License

  Copyright (c) 2017-2021 Michael Truog <mjtruog at protonmail dot com>

  Permission is hereby granted, free of charge, to any person obtaining a
  copy of this software and associated documentation files (the "Software"),
  to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense,
  and/or sell copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  DEALINGS IN THE SOFTWARE.

 -}

-- | Haskell <https://cloudi.org/api.html#1_Intro CloudI API>.
-- Example usage is available in the
-- <https://cloudi.org/tutorials.html#cloudi_examples integration tests>.

module Foreign.CloudI
    ( Instance.RequestType(..)
    , Instance.Source
    , Instance.Response(..)
    , Instance.Callback
    , Instance.T
    , transIdNull
    , invalidInputError
    , messageDecodingError
    , terminateError
    , Exception
    , FatalError
    , Result
    , api
    , threadCount
    , subscribe
    , subscribeCount
    , unsubscribe
    , sendAsync
    , sendSync
    , mcastAsync
    , forward_
    , forwardAsync
    , forwardSync
    , return_
    , returnAsync
    , returnSync
    , recvAsync
    , processIndex
    , processCount
    , processCountMax
    , processCountMin
    , prefix
    , timeoutInitialize
    , timeoutAsync
    , timeoutSync
    , timeoutTerminate
    , priorityDefault
    , poll
    , shutdown
    , threadCreate
    , threadsWait
    , infoKeyValueParse
    , infoKeyValueNew
    ) where

import Prelude hiding (init,length,(<>))
import Data.Bits (shiftL,(.|.))
import Data.Maybe (fromMaybe)
import Data.Typeable (Typeable)
import qualified Control.Exception as Exception
import qualified Control.Concurrent as Concurrent
import qualified Data.Array.IArray as IArray
import qualified Data.Binary.Get as Get
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Monoid as Monoid
import qualified Data.Sequence as Sequence
import qualified Data.Time.Clock as Clock
import qualified Data.Time.Clock.POSIX as POSIX (getPOSIXTime)
import qualified Data.Word as Word
import qualified Foreign.C.Types as C
import qualified Foreign.Erlang as Erlang
import qualified Foreign.CloudI.Instance as Instance
import qualified System.IO as SysIO
import qualified System.IO.Error as SysIOErr
import qualified System.IO.Unsafe as Unsafe
import qualified System.Posix.Env as POSIX (getEnv)
import qualified System.Posix.Process as POSIX (exitImmediately)
import qualified System.Exit as Exit
type Array = IArray.Array
type Builder = Builder.Builder
type ByteString = ByteString.ByteString
type Get = Get.Get
type Handle = SysIO.Handle
type LazyByteString = LazyByteString.ByteString
type Map = Map.Map
type RequestType = Instance.RequestType
type SomeException = Exception.SomeException
type SomeAsyncException = Exception.SomeAsyncException
type AsyncException = Exception.AsyncException
type AssertionFailed = Exception.AssertionFailed
type ExitCode = Exit.ExitCode
type Source = Instance.Source
type ThreadId = Concurrent.ThreadId
type Word32 = Word.Word32

messageInit :: Word32
messageInit :: Word32
messageInit = Word32
1
messageSendAsync :: Word32
messageSendAsync :: Word32
messageSendAsync = Word32
2
messageSendSync :: Word32
messageSendSync :: Word32
messageSendSync = Word32
3
messageRecvAsync :: Word32
messageRecvAsync :: Word32
messageRecvAsync = Word32
4
messageReturnAsync :: Word32
messageReturnAsync :: Word32
messageReturnAsync = Word32
5
messageReturnSync :: Word32
messageReturnSync :: Word32
messageReturnSync = Word32
6
messageReturnsAsync :: Word32
messageReturnsAsync :: Word32
messageReturnsAsync = Word32
7
messageKeepalive :: Word32
messageKeepalive :: Word32
messageKeepalive = Word32
8
messageReinit :: Word32
messageReinit :: Word32
messageReinit = Word32
9
messageSubscribeCount :: Word32
messageSubscribeCount :: Word32
messageSubscribeCount = Word32
10
messageTerm :: Word32
messageTerm :: Word32
messageTerm = Word32
11

data Message =
      MessageSend (
        RequestType, ByteString, ByteString, ByteString, ByteString,
        Int, Int, ByteString, Source)
    | MessageKeepalive

-- | a null trans_id is used to check for a timeout or
-- to get the oldest response with recv_async
transIdNull :: ByteString
transIdNull :: ByteString
transIdNull = String -> ByteString
Char8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
List.replicate Int
16 Char
'\0'

invalidInputError :: String
invalidInputError :: String
invalidInputError = String
"Invalid Input"
messageDecodingError :: String
messageDecodingError :: String
messageDecodingError = String
"Message Decoding Error"
terminateError :: String
terminateError :: String
terminateError = String
"Terminate"

data Exception s =
      ReturnSync (Instance.T s)
    | ReturnAsync (Instance.T s)
    | ForwardSync (Instance.T s)
    | ForwardAsync (Instance.T s)
    | Terminate (Instance.T s)
    deriving (Int -> Exception s -> ShowS
[Exception s] -> ShowS
Exception s -> String
(Int -> Exception s -> ShowS)
-> (Exception s -> String)
-> ([Exception s] -> ShowS)
-> Show (Exception s)
forall s. Int -> Exception s -> ShowS
forall s. [Exception s] -> ShowS
forall s. Exception s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exception s] -> ShowS
$cshowList :: forall s. [Exception s] -> ShowS
show :: Exception s -> String
$cshow :: forall s. Exception s -> String
showsPrec :: Int -> Exception s -> ShowS
$cshowsPrec :: forall s. Int -> Exception s -> ShowS
Show, Typeable)

instance Typeable s => Exception.Exception (Exception s)

data FatalError = FatalError

instance Exception.Exception FatalError

instance Show FatalError where
    showsPrec :: Int -> FatalError -> ShowS
showsPrec Int
_ FatalError
FatalError = String -> ShowS
showString String
"FatalError"

printException :: String -> IO ()
printException :: String -> IO ()
printException String
str =
    Handle -> String -> IO ()
SysIO.hPutStrLn Handle
SysIO.stderr (String
"Exception: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str)

printError :: String -> IO ()
printError :: String -> IO ()
printError String
str =
    Handle -> String -> IO ()
SysIO.hPutStrLn Handle
SysIO.stderr (String
"Error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str)

data CallbackResult s =
      ReturnI (ByteString, ByteString, s, Instance.T s)
    | ForwardI (ByteString, ByteString, ByteString, Int, Int,
                s, Instance.T s)
    | Finished (Instance.T s)

type Result a = Either String a

infixr 4 <>
(<>) :: Monoid.Monoid m => m -> m -> m
<> :: m -> m -> m
(<>) = m -> m -> m
forall a. Monoid a => a -> a -> a
Monoid.mappend

-- | creates an instance of the CloudI API
api :: Typeable s => Int -> s -> Maybe Bool ->
    IO (Result (Instance.T s))
api :: Int -> s -> Maybe Bool -> IO (Result (T s))
api Int
threadIndex s
state Maybe Bool
terminateReturnValueOpt = do
    Handle -> TextEncoding -> IO ()
SysIO.hSetEncoding Handle
SysIO.stdout TextEncoding
SysIO.utf8
    Handle -> BufferMode -> IO ()
SysIO.hSetBuffering Handle
SysIO.stdout BufferMode
SysIO.LineBuffering
    Handle -> TextEncoding -> IO ()
SysIO.hSetEncoding Handle
SysIO.stderr TextEncoding
SysIO.utf8
    Handle -> BufferMode -> IO ()
SysIO.hSetBuffering Handle
SysIO.stderr BufferMode
SysIO.LineBuffering
    Maybe String
protocolValue <- String -> IO (Maybe String)
POSIX.getEnv String
"CLOUDI_API_INIT_PROTOCOL"
    Maybe String
bufferSizeValue <- String -> IO (Maybe String)
POSIX.getEnv String
"CLOUDI_API_INIT_BUFFER_SIZE"
    case (Maybe String
protocolValue, Maybe String
bufferSizeValue) of
        (Just String
protocol, Just String
bufferSizeStr) ->
            let terminateReturnValue :: Bool
terminateReturnValue = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
terminateReturnValueOpt
                terminateException :: Bool
terminateException = Bool -> Bool
not Bool
terminateReturnValue
                bufferSize :: Int
bufferSize = String -> Int
forall a. Read a => String -> a
read String
bufferSizeStr :: Int
                fd :: CInt
fd = Int32 -> CInt
C.CInt (Int32 -> CInt) -> Int32 -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
threadIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                useHeader :: Bool
useHeader = String
protocol String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"udp"
                timeoutTerminate' :: Int
timeoutTerminate' = Int
10 -- TIMEOUT_TERMINATE_MIN
                initTerms :: OtpErlangTerm
initTerms = ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"init")
            in
            case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
initTerms (-Int
1) of
                Left Error
err ->
                    Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
                Right LazyByteString
initBinary -> do
                    T s
api0 <- s -> Bool -> String -> CInt -> Bool -> Int -> Int -> IO (T s)
forall s.
s -> Bool -> String -> CInt -> Bool -> Int -> Int -> IO (T s)
Instance.make s
state Bool
terminateException
                        String
protocol CInt
fd Bool
useHeader Int
bufferSize Int
timeoutTerminate'
                    T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
initBinary
                    Result (Bool, T s)
result <- T s -> Int -> Bool -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest T s
api0 (-Int
1) Bool
False
                    case Result (Bool, T s)
result of
                        Left String
err ->
                            -- Terminate exception not used here
                            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left String
err
                        Right (Bool
_, T s
api1) ->
                            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api1
        (Maybe String
_, Maybe String
_) -> do
            Handle -> String -> IO ()
SysIO.hPutStrLn Handle
SysIO.stderr
                String
"CloudI service execution must occur in CloudI"
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left String
invalidInputError

-- | returns the thread count from the service configuration
threadCount :: IO (Result Int)
threadCount :: IO (Result Int)
threadCount = do
    Maybe String
threadCountValue <- String -> IO (Maybe String)
POSIX.getEnv String
"CLOUDI_API_INIT_THREAD_COUNT"
    case Maybe String
threadCountValue of
        Maybe String
Nothing ->
            Result Int -> IO (Result Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Int -> IO (Result Int)) -> Result Int -> IO (Result Int)
forall a b. (a -> b) -> a -> b
$ String -> Result Int
forall a b. a -> Either a b
Left String
invalidInputError
        Just String
threadCountStr ->
            Result Int -> IO (Result Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Int -> IO (Result Int)) -> Result Int -> IO (Result Int)
forall a b. (a -> b) -> a -> b
$ Int -> Result Int
forall a b. b -> Either a b
Right (String -> Int
forall a. Read a => String -> a
read String
threadCountStr :: Int)

-- | subscribes to a service name pattern with a callback
subscribe :: Instance.T s -> ByteString -> Instance.Callback s ->
    IO (Result (Instance.T s))
subscribe :: T s -> ByteString -> Callback s -> IO (Result (T s))
subscribe T s
api0 ByteString
pattern Callback s
f =
    let subscribeTerms :: OtpErlangTerm
subscribeTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"subscribe")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
pattern]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
subscribeTerms (-Int
1) of
        Left Error
err ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
subscribeBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
subscribeBinary
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right (T s -> Result (T s)) -> T s -> Result (T s)
forall a b. (a -> b) -> a -> b
$ T s -> ByteString -> Callback s -> T s
forall s. T s -> ByteString -> Callback s -> T s
Instance.callbacksAdd T s
api0 ByteString
pattern Callback s
f

-- | returns the number of subscriptions for a single service name pattern
subscribeCount :: Typeable s => Instance.T s -> ByteString ->
    IO (Result (Int, Instance.T s))
subscribeCount :: T s -> ByteString -> IO (Result (Int, T s))
subscribeCount api0 :: T s
api0@Instance.T{
      terminateException :: forall s. T s -> Bool
Instance.terminateException = Bool
terminateException}
    ByteString
pattern =
    let subscribeCountTerms :: OtpErlangTerm
subscribeCountTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"subscribe_count")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
pattern]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
subscribeCountTerms (-Int
1) of
        Left Error
err ->
            Result (Int, T s) -> IO (Result (Int, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Int, T s) -> IO (Result (Int, T s)))
-> Result (Int, T s) -> IO (Result (Int, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Int, T s)
forall a b. a -> Either a b
Left (String -> Result (Int, T s)) -> String -> Result (Int, T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
subscribeCountBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
subscribeCountBinary
            Result (Bool, T s)
result <- T s -> Int -> Bool -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest T s
api0 (-Int
1) Bool
False
            case Result (Bool, T s)
result of
                Left String
err ->
                    if String
err String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
terminateError Bool -> Bool -> Bool
&& Bool
terminateException then
                        Exception s -> IO (Result (Int, T s))
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s -> IO (Result (Int, T s)))
-> Exception s -> IO (Result (Int, T s))
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
Terminate T s
api0
                    else
                        Result (Int, T s) -> IO (Result (Int, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Int, T s) -> IO (Result (Int, T s)))
-> Result (Int, T s) -> IO (Result (Int, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Int, T s)
forall a b. a -> Either a b
Left String
err
                Right (Bool
_, api1 :: T s
api1@Instance.T{subscribeCount :: forall s. T s -> Int
Instance.subscribeCount = Int
count}) ->
                    Result (Int, T s) -> IO (Result (Int, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Int, T s) -> IO (Result (Int, T s)))
-> Result (Int, T s) -> IO (Result (Int, T s))
forall a b. (a -> b) -> a -> b
$ (Int, T s) -> Result (Int, T s)
forall a b. b -> Either a b
Right (Int
count, T s
api1)

-- | unsubscribes from a service name pattern once
unsubscribe :: Instance.T s -> ByteString ->
    IO (Result (Instance.T s))
unsubscribe :: T s -> ByteString -> IO (Result (T s))
unsubscribe T s
api0 ByteString
pattern =
    let unsubscribeTerms :: OtpErlangTerm
unsubscribeTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"unsubscribe")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
pattern]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
unsubscribeTerms (-Int
1) of
        Left Error
err ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
unsubscribeBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
unsubscribeBinary
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right (T s -> Result (T s)) -> T s -> Result (T s)
forall a b. (a -> b) -> a -> b
$ T s -> ByteString -> T s
forall s. T s -> ByteString -> T s
Instance.callbacksRemove T s
api0 ByteString
pattern

-- | sends an asynchronous service request
sendAsync :: Typeable s => Instance.T s -> ByteString -> ByteString ->
    Maybe Int -> Maybe ByteString -> Maybe Int ->
    IO (Result (ByteString, Instance.T s))
sendAsync :: T s
-> ByteString
-> ByteString
-> Maybe Int
-> Maybe ByteString
-> Maybe Int
-> IO (Result (ByteString, T s))
sendAsync api0 :: T s
api0@Instance.T{
      terminateException :: forall s. T s -> Bool
Instance.terminateException = Bool
terminateException
    , timeoutAsync :: forall s. T s -> Int
Instance.timeoutAsync = Int
timeoutAsync'
    , priorityDefault :: forall s. T s -> Int
Instance.priorityDefault = Int
priorityDefault'}
    ByteString
name ByteString
request Maybe Int
timeoutOpt Maybe ByteString
requestInfoOpt Maybe Int
priorityOpt =
    let timeout :: Int
timeout = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
timeoutAsync' Maybe Int
timeoutOpt
        requestInfo :: ByteString
requestInfo = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
ByteString.empty Maybe ByteString
requestInfoOpt
        priority :: Int
priority = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
priorityDefault' Maybe Int
priorityOpt
        sendAsyncTerms :: OtpErlangTerm
sendAsyncTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"send_async")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
name
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
requestInfo
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
request
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
priority]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
sendAsyncTerms (-Int
1) of
        Left Error
err ->
            Result (ByteString, T s) -> IO (Result (ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, T s) -> IO (Result (ByteString, T s)))
-> Result (ByteString, T s) -> IO (Result (ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (ByteString, T s)
forall a b. a -> Either a b
Left (String -> Result (ByteString, T s))
-> String -> Result (ByteString, T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
sendAsyncBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
sendAsyncBinary
            Result (Bool, T s)
result <- T s -> Int -> Bool -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest T s
api0 (-Int
1) Bool
False
            case Result (Bool, T s)
result of
                Left String
err ->
                    if String
err String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
terminateError Bool -> Bool -> Bool
&& Bool
terminateException then
                        Exception s -> IO (Result (ByteString, T s))
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s -> IO (Result (ByteString, T s)))
-> Exception s -> IO (Result (ByteString, T s))
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
Terminate T s
api0
                    else
                        Result (ByteString, T s) -> IO (Result (ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, T s) -> IO (Result (ByteString, T s)))
-> Result (ByteString, T s) -> IO (Result (ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (ByteString, T s)
forall a b. a -> Either a b
Left String
err
                Right (Bool
_, api1 :: T s
api1@Instance.T{transId :: forall s. T s -> ByteString
Instance.transId = ByteString
transId}) ->
                    Result (ByteString, T s) -> IO (Result (ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, T s) -> IO (Result (ByteString, T s)))
-> Result (ByteString, T s) -> IO (Result (ByteString, T s))
forall a b. (a -> b) -> a -> b
$ (ByteString, T s) -> Result (ByteString, T s)
forall a b. b -> Either a b
Right (ByteString
transId, T s
api1)

-- | sends a synchronous service request
sendSync :: Typeable s => Instance.T s -> ByteString -> ByteString ->
    Maybe Int -> Maybe ByteString -> Maybe Int ->
    IO (Result (ByteString, ByteString, ByteString, Instance.T s))
sendSync :: T s
-> ByteString
-> ByteString
-> Maybe Int
-> Maybe ByteString
-> Maybe Int
-> IO (Result (ByteString, ByteString, ByteString, T s))
sendSync api0 :: T s
api0@Instance.T{
      terminateException :: forall s. T s -> Bool
Instance.terminateException = Bool
terminateException
    , timeoutSync :: forall s. T s -> Int
Instance.timeoutSync = Int
timeoutSync'
    , priorityDefault :: forall s. T s -> Int
Instance.priorityDefault = Int
priorityDefault'}
    ByteString
name ByteString
request Maybe Int
timeoutOpt Maybe ByteString
requestInfoOpt Maybe Int
priorityOpt =
    let timeout :: Int
timeout = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
timeoutSync' Maybe Int
timeoutOpt
        requestInfo :: ByteString
requestInfo = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
ByteString.empty Maybe ByteString
requestInfoOpt
        priority :: Int
priority = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
priorityDefault' Maybe Int
priorityOpt
        sendSyncTerms :: OtpErlangTerm
sendSyncTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"send_sync")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
name
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
requestInfo
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
request
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
priority]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
sendSyncTerms (-Int
1) of
        Left Error
err ->
            Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, ByteString, ByteString, T s)
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (ByteString, ByteString, ByteString, T s)
forall a b. a -> Either a b
Left (String -> Result (ByteString, ByteString, ByteString, T s))
-> String -> Result (ByteString, ByteString, ByteString, T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
sendSyncBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
sendSyncBinary
            Result (Bool, T s)
result <- T s -> Int -> Bool -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest T s
api0 (-Int
1) Bool
False
            case Result (Bool, T s)
result of
                Left String
err ->
                    if String
err String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
terminateError Bool -> Bool -> Bool
&& Bool
terminateException then
                        Exception s
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Exception s
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
Terminate T s
api0
                    else
                        Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, ByteString, ByteString, T s)
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (ByteString, ByteString, ByteString, T s)
forall a b. a -> Either a b
Left String
err
                Right (Bool
_, api1 :: T s
api1@Instance.T{
                      responseInfo :: forall s. T s -> ByteString
Instance.responseInfo = ByteString
responseInfo
                    , response :: forall s. T s -> ByteString
Instance.response = ByteString
response
                    , transId :: forall s. T s -> ByteString
Instance.transId = ByteString
transId}) ->
                    Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, ByteString, ByteString, T s)
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString, T s)
-> Result (ByteString, ByteString, ByteString, T s)
forall a b. b -> Either a b
Right (ByteString
responseInfo, ByteString
response, ByteString
transId, T s
api1)

-- | sends asynchronous service requests to all subscribers
-- of the matching service name pattern
mcastAsync :: Typeable s => Instance.T s -> ByteString -> ByteString ->
    Maybe Int -> Maybe ByteString -> Maybe Int ->
    IO (Result (Array Int ByteString, Instance.T s))
mcastAsync :: T s
-> ByteString
-> ByteString
-> Maybe Int
-> Maybe ByteString
-> Maybe Int
-> IO (Result (Array Int ByteString, T s))
mcastAsync api0 :: T s
api0@Instance.T{
      terminateException :: forall s. T s -> Bool
Instance.terminateException = Bool
terminateException
    , timeoutAsync :: forall s. T s -> Int
Instance.timeoutAsync = Int
timeoutAsync'
    , priorityDefault :: forall s. T s -> Int
Instance.priorityDefault = Int
priorityDefault'}
    ByteString
name ByteString
request Maybe Int
timeoutOpt Maybe ByteString
requestInfoOpt Maybe Int
priorityOpt =
    let timeout :: Int
timeout = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
timeoutAsync' Maybe Int
timeoutOpt
        requestInfo :: ByteString
requestInfo = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
ByteString.empty Maybe ByteString
requestInfoOpt
        priority :: Int
priority = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
priorityDefault' Maybe Int
priorityOpt
        mcastAsyncTerms :: OtpErlangTerm
mcastAsyncTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"mcast_async")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
name
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
requestInfo
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
request
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
priority]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
mcastAsyncTerms (-Int
1) of
        Left Error
err ->
            Result (Array Int ByteString, T s)
-> IO (Result (Array Int ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Array Int ByteString, T s)
 -> IO (Result (Array Int ByteString, T s)))
-> Result (Array Int ByteString, T s)
-> IO (Result (Array Int ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Array Int ByteString, T s)
forall a b. a -> Either a b
Left (String -> Result (Array Int ByteString, T s))
-> String -> Result (Array Int ByteString, T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
mcastAsyncBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
mcastAsyncBinary
            Result (Bool, T s)
result <- T s -> Int -> Bool -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest T s
api0 (-Int
1) Bool
False
            case Result (Bool, T s)
result of
                Left String
err ->
                    if String
err String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
terminateError Bool -> Bool -> Bool
&& Bool
terminateException then
                        Exception s -> IO (Result (Array Int ByteString, T s))
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s -> IO (Result (Array Int ByteString, T s)))
-> Exception s -> IO (Result (Array Int ByteString, T s))
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
Terminate T s
api0
                    else
                        Result (Array Int ByteString, T s)
-> IO (Result (Array Int ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Array Int ByteString, T s)
 -> IO (Result (Array Int ByteString, T s)))
-> Result (Array Int ByteString, T s)
-> IO (Result (Array Int ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Array Int ByteString, T s)
forall a b. a -> Either a b
Left String
err
                Right (Bool
_, api1 :: T s
api1@Instance.T{transIds :: forall s. T s -> Array Int ByteString
Instance.transIds = Array Int ByteString
transIds}) ->
                    Result (Array Int ByteString, T s)
-> IO (Result (Array Int ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Array Int ByteString, T s)
 -> IO (Result (Array Int ByteString, T s)))
-> Result (Array Int ByteString, T s)
-> IO (Result (Array Int ByteString, T s))
forall a b. (a -> b) -> a -> b
$ (Array Int ByteString, T s) -> Result (Array Int ByteString, T s)
forall a b. b -> Either a b
Right (Array Int ByteString
transIds, T s
api1)

-- | forwards a service request to a different service name
forward_ :: Typeable s =>
    Instance.T s -> Instance.RequestType -> ByteString ->
    ByteString -> ByteString -> Int -> Int -> ByteString -> Source ->
    IO ()
forward_ :: T s
-> RequestType
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO ()
forward_ T s
api0 RequestType
Instance.ASYNC = T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO ()
forall s.
Typeable s =>
T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO ()
forwardAsync T s
api0
forward_ T s
api0 RequestType
Instance.SYNC = T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO ()
forall s.
Typeable s =>
T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO ()
forwardSync T s
api0

forwardAsyncI :: Instance.T s -> ByteString ->
    ByteString -> ByteString -> Int -> Int -> ByteString -> Source ->
    IO (Result (Instance.T s))
forwardAsyncI :: T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forwardAsyncI T s
api0 ByteString
name ByteString
responseInfo ByteString
response Int
timeout Int
priority ByteString
transId Source
pid = do
    let forwardTerms :: OtpErlangTerm
forwardTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"forward_async")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
name
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
responseInfo
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
response
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
priority
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
transId
            , Source -> OtpErlangTerm
Erlang.OtpErlangPid Source
pid]
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
forwardTerms (-Int
1) of
        Left Error
err ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
forwardBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
forwardBinary
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api0

-- | forwards an asynchronous service request to a different service name
forwardAsync :: Typeable s => Instance.T s -> ByteString ->
    ByteString -> ByteString -> Int -> Int -> ByteString -> Source ->
    IO ()
forwardAsync :: T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO ()
forwardAsync T s
api0 ByteString
name ByteString
responseInfo ByteString
response Int
timeout Int
priority ByteString
transId Source
pid = do
    Result (T s)
result <- T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forwardAsyncI T s
api0
        ByteString
name ByteString
responseInfo ByteString
response Int
timeout Int
priority ByteString
transId Source
pid
    case Result (T s)
result of
        Left String
err ->
            String -> IO ()
forall a. HasCallStack => String -> a
error String
err
        Right T s
api1 ->
            Exception s -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s -> IO ()) -> Exception s -> IO ()
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
ForwardAsync T s
api1

forwardSyncI :: Instance.T s -> ByteString ->
    ByteString -> ByteString -> Int -> Int -> ByteString -> Source ->
    IO (Result (Instance.T s))
forwardSyncI :: T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forwardSyncI T s
api0 ByteString
name ByteString
responseInfo ByteString
response Int
timeout Int
priority ByteString
transId Source
pid = do
    let forwardTerms :: OtpErlangTerm
forwardTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"forward_sync")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
name
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
responseInfo
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
response
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
priority
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
transId
            , Source -> OtpErlangTerm
Erlang.OtpErlangPid Source
pid]
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
forwardTerms (-Int
1) of
        Left Error
err ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
forwardBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
forwardBinary
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api0

-- | forwards a synchronous service request to a different service name
forwardSync :: Typeable s => Instance.T s -> ByteString ->
    ByteString -> ByteString -> Int -> Int -> ByteString -> Source ->
    IO ()
forwardSync :: T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO ()
forwardSync T s
api0 ByteString
name ByteString
responseInfo ByteString
response Int
timeout Int
priority ByteString
transId Source
pid = do
    Result (T s)
result <- T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forwardSyncI T s
api0
        ByteString
name ByteString
responseInfo ByteString
response Int
timeout Int
priority ByteString
transId Source
pid
    case Result (T s)
result of
        Left String
err ->
            String -> IO ()
forall a. HasCallStack => String -> a
error String
err
        Right T s
api1 ->
            Exception s -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s -> IO ()) -> Exception s -> IO ()
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
ForwardSync T s
api1

-- | provides a response to a service request
return_ :: Typeable s =>
    Instance.T s -> Instance.RequestType -> ByteString -> ByteString ->
    ByteString -> ByteString -> Int -> ByteString -> Source ->
    IO ()
return_ :: T s
-> RequestType
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO ()
return_ T s
api0 RequestType
Instance.ASYNC = T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO ()
forall s.
Typeable s =>
T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO ()
returnAsync T s
api0
return_ T s
api0 RequestType
Instance.SYNC = T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO ()
forall s.
Typeable s =>
T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO ()
returnSync T s
api0

returnAsyncI :: Instance.T s -> ByteString -> ByteString ->
    ByteString -> ByteString -> Int -> ByteString -> Source ->
    IO (Result (Instance.T s))
returnAsyncI :: T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
returnAsyncI T s
api0 ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid = do
    let returnTerms :: OtpErlangTerm
returnTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"return_async")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
name
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
pattern
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
responseInfo
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
response
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
transId
            , Source -> OtpErlangTerm
Erlang.OtpErlangPid Source
pid]
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
returnTerms (-Int
1) of
        Left Error
err ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
returnBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
returnBinary
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api0

-- | provides a response to an asynchronous service request
returnAsync :: Typeable s => Instance.T s -> ByteString -> ByteString ->
    ByteString -> ByteString -> Int -> ByteString -> Source ->
    IO ()
returnAsync :: T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO ()
returnAsync T s
api0 ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid = do
    Result (T s)
result <- T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
returnAsyncI T s
api0
        ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid
    case Result (T s)
result of
        Left String
err ->
            String -> IO ()
forall a. HasCallStack => String -> a
error String
err
        Right T s
api1 ->
            Exception s -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s -> IO ()) -> Exception s -> IO ()
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
ReturnAsync T s
api1

returnSyncI :: Instance.T s -> ByteString -> ByteString ->
    ByteString -> ByteString -> Int -> ByteString -> Source ->
    IO (Result (Instance.T s))
returnSyncI :: T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
returnSyncI T s
api0 ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid = do
    let returnTerms :: OtpErlangTerm
returnTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"return_sync")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
name
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
pattern
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
responseInfo
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
response
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
transId
            , Source -> OtpErlangTerm
Erlang.OtpErlangPid Source
pid]
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
returnTerms (-Int
1) of
        Left Error
err ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
returnBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
returnBinary
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api0

-- | provides a response to a synchronous service request
returnSync :: Typeable s => Instance.T s -> ByteString -> ByteString ->
    ByteString -> ByteString -> Int -> ByteString -> Source ->
    IO ()
returnSync :: T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO ()
returnSync T s
api0 ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid = do
    Result (T s)
result <- T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
returnSyncI T s
api0
        ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid
    case Result (T s)
result of
        Left String
err ->
            String -> IO ()
forall a. HasCallStack => String -> a
error String
err
        Right T s
api1 ->
            Exception s -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s -> IO ()) -> Exception s -> IO ()
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
ReturnSync T s
api1

-- | blocks to receive an asynchronous service request response
recvAsync :: Typeable s => Instance.T s ->
    Maybe Int -> Maybe ByteString -> Maybe Bool ->
    IO (Result (ByteString, ByteString, ByteString, Instance.T s))
recvAsync :: T s
-> Maybe Int
-> Maybe ByteString
-> Maybe Bool
-> IO (Result (ByteString, ByteString, ByteString, T s))
recvAsync api0 :: T s
api0@Instance.T{
      terminateException :: forall s. T s -> Bool
Instance.terminateException = Bool
terminateException
    , timeoutSync :: forall s. T s -> Int
Instance.timeoutSync = Int
timeoutSync'}
    Maybe Int
timeoutOpt Maybe ByteString
transIdOpt Maybe Bool
consumeOpt =
    let timeout :: Int
timeout = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
timeoutSync' Maybe Int
timeoutOpt
        transId :: ByteString
transId = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
transIdNull Maybe ByteString
transIdOpt
        consume :: Bool
consume = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
consumeOpt
        recvAsyncTerms :: OtpErlangTerm
recvAsyncTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"recv_async")
            , Int -> OtpErlangTerm
Erlang.OtpErlangInteger Int
timeout
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangBinary ByteString
transId
            , Bool -> OtpErlangTerm
Erlang.OtpErlangAtomBool Bool
consume]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
recvAsyncTerms (-Int
1) of
        Left Error
err ->
            Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, ByteString, ByteString, T s)
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (ByteString, ByteString, ByteString, T s)
forall a b. a -> Either a b
Left (String -> Result (ByteString, ByteString, ByteString, T s))
-> String -> Result (ByteString, ByteString, ByteString, T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
recvAsyncBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
recvAsyncBinary
            Result (Bool, T s)
result <- T s -> Int -> Bool -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest T s
api0 (-Int
1) Bool
False
            case Result (Bool, T s)
result of
                Left String
err ->
                    if String
err String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
terminateError Bool -> Bool -> Bool
&& Bool
terminateException then
                        Exception s
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall e a. Exception e => e -> IO a
Exception.throwIO (Exception s
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Exception s
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ T s -> Exception s
forall s. T s -> Exception s
Terminate T s
api0
                    else
                        Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, ByteString, ByteString, T s)
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (ByteString, ByteString, ByteString, T s)
forall a b. a -> Either a b
Left String
err
                Right (Bool
_, api1 :: T s
api1@Instance.T{
                      responseInfo :: forall s. T s -> ByteString
Instance.responseInfo = ByteString
responseInfo
                    , response :: forall s. T s -> ByteString
Instance.response = ByteString
response
                    , transId :: forall s. T s -> ByteString
Instance.transId = ByteString
transId'}) ->
                    Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (ByteString, ByteString, ByteString, T s)
 -> IO (Result (ByteString, ByteString, ByteString, T s)))
-> Result (ByteString, ByteString, ByteString, T s)
-> IO (Result (ByteString, ByteString, ByteString, T s))
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString, T s)
-> Result (ByteString, ByteString, ByteString, T s)
forall a b. b -> Either a b
Right (ByteString
responseInfo, ByteString
response, ByteString
transId', T s
api1)

-- | returns the 0-based index of this process in the service instance
processIndex :: Instance.T s -> Int
processIndex :: T s -> Int
processIndex Instance.T{processIndex :: forall s. T s -> Int
Instance.processIndex = Int
processIndex'} =
    Int
processIndex'

-- | returns the current process count based on the service configuration
processCount :: Instance.T s -> Int
processCount :: T s -> Int
processCount Instance.T{processCount :: forall s. T s -> Int
Instance.processCount = Int
processCount'} =
    Int
processCount'

-- | returns the count_process_dynamic maximum count
-- based on the service configuration
processCountMax :: Instance.T s -> Int
processCountMax :: T s -> Int
processCountMax Instance.T{processCountMax :: forall s. T s -> Int
Instance.processCountMax = Int
processCountMax'} =
    Int
processCountMax'

-- | returns the count_process_dynamic minimum count
-- based on the service configuration
processCountMin :: Instance.T s -> Int
processCountMin :: T s -> Int
processCountMin Instance.T{processCountMin :: forall s. T s -> Int
Instance.processCountMin = Int
processCountMin'} =
    Int
processCountMin'

-- | returns the service name pattern prefix from the service configuration
prefix :: Instance.T s -> ByteString
prefix :: T s -> ByteString
prefix Instance.T{prefix :: forall s. T s -> ByteString
Instance.prefix = ByteString
prefix'} =
    ByteString
prefix'

-- | returns the service initialization timeout
-- from the service configuration
timeoutInitialize :: Instance.T s -> Int
timeoutInitialize :: T s -> Int
timeoutInitialize Instance.T{timeoutInitialize :: forall s. T s -> Int
Instance.timeoutInitialize = Int
timeoutInitialize'} =
    Int
timeoutInitialize'

-- | returns the default asynchronous service request send timeout
-- from the service configuration
timeoutAsync :: Instance.T s -> Int
timeoutAsync :: T s -> Int
timeoutAsync Instance.T{timeoutAsync :: forall s. T s -> Int
Instance.timeoutAsync = Int
timeoutAsync'} =
    Int
timeoutAsync'

-- | returns the default synchronous service request send timeout
-- from the service configuration
timeoutSync :: Instance.T s -> Int
timeoutSync :: T s -> Int
timeoutSync Instance.T{timeoutSync :: forall s. T s -> Int
Instance.timeoutSync = Int
timeoutSync'} =
    Int
timeoutSync'

-- | returns the service termination timeout
-- based on the service configuration
timeoutTerminate :: Instance.T s -> Int
timeoutTerminate :: T s -> Int
timeoutTerminate Instance.T{timeoutTerminate :: forall s. T s -> Int
Instance.timeoutTerminate = Int
timeoutTerminate'} =
    Int
timeoutTerminate'

-- | returns the default service request send priority
-- from the service configuration
priorityDefault :: Instance.T s -> Int
priorityDefault :: T s -> Int
priorityDefault Instance.T{priorityDefault :: forall s. T s -> Int
Instance.priorityDefault = Int
priorityDefault'} =
    Int
priorityDefault'

nullResponse :: RequestType -> ByteString -> ByteString ->
    ByteString -> ByteString -> Int -> Int -> ByteString -> Source ->
    s -> Instance.T s -> IO (Instance.Response s)
nullResponse :: RequestType
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> s
-> T s
-> IO (Response s)
nullResponse RequestType
_ ByteString
_ ByteString
_ ByteString
_ ByteString
_ Int
_ Int
_ ByteString
_ Source
_ s
state T s
api0 =
    Response s -> IO (Response s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Response s -> IO (Response s)) -> Response s -> IO (Response s)
forall a b. (a -> b) -> a -> b
$ (s, T s) -> Response s
forall s. (s, T s) -> Response s
Instance.Null (s
state, T s
api0)

callbackExceptionFatal :: SomeException -> IO ()
callbackExceptionFatal :: SomeException -> IO ()
callbackExceptionFatal SomeException
e = do
    String -> IO ()
printException (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
    ExitCode -> IO ()
POSIX.exitImmediately (Int -> ExitCode
Exit.ExitFailure Int
1)

callbackException :: SomeException -> IO ()
callbackException :: SomeException -> IO ()
callbackException SomeException
e
    | Just AsyncException
_ <- (SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e :: Maybe AsyncException) =
        SomeException -> IO ()
callbackExceptionFatal SomeException
e
    | Just SomeAsyncException
_ <- (SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e :: Maybe SomeAsyncException) =
        SomeException -> IO ()
callbackExceptionFatal SomeException
e
    | Just AssertionFailed
_ <- (SomeException -> Maybe AssertionFailed
forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e :: Maybe AssertionFailed) =
        SomeException -> IO ()
callbackExceptionFatal SomeException
e
    | Just FatalError
_ <- (SomeException -> Maybe FatalError
forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e :: Maybe FatalError) =
        SomeException -> IO ()
callbackExceptionFatal SomeException
e
    | Just ExitCode
exitCode <- (SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e :: Maybe ExitCode) =
        ExitCode -> IO ()
POSIX.exitImmediately ExitCode
exitCode
    | Bool
otherwise =
        String -> IO ()
printException (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e

callback :: Typeable s => Instance.T s ->
    (RequestType, ByteString, ByteString, ByteString, ByteString,
     Int, Int, ByteString, Source) -> IO (Result (Instance.T s))
callback :: T s
-> (RequestType, ByteString, ByteString, ByteString, ByteString,
    Int, Int, ByteString, Source)
-> IO (Result (T s))
callback api0 :: T s
api0@Instance.T{
      state :: forall s. T s -> s
Instance.state = s
state
    , callbacks :: forall s. T s -> Map ByteString (Seq (Callback s))
Instance.callbacks = Map ByteString (Seq (Callback s))
callbacks}
    (RequestType
requestType, ByteString
name, ByteString
pattern, ByteString
requestInfo, ByteString
request,
     Int
timeout, Int
priority, ByteString
transId, Source
pid) = do
    let (Callback s
callbackF, Map ByteString (Seq (Callback s))
callbacksNew) = case ByteString
-> Map ByteString (Seq (Callback s)) -> Maybe (Seq (Callback s))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
pattern Map ByteString (Seq (Callback s))
callbacks of
            Maybe (Seq (Callback s))
Nothing ->
                (Callback s
forall s.
RequestType
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> s
-> T s
-> IO (Response s)
nullResponse, Map ByteString (Seq (Callback s))
callbacks)
            Just Seq (Callback s)
functionQueue ->
                let f :: Callback s
f = Seq (Callback s) -> Int -> Callback s
forall a. Seq a -> Int -> a
Sequence.index Seq (Callback s)
functionQueue Int
0
                    functionQueueNew :: Seq (Callback s)
functionQueueNew = Seq (Callback s) -> Callback s -> Seq (Callback s)
forall a. Seq a -> a -> Seq a
(Sequence.|>)
                        (Int -> Seq (Callback s) -> Seq (Callback s)
forall a. Int -> Seq a -> Seq a
Sequence.drop Int
1 Seq (Callback s)
functionQueue) Callback s
f
                in
                (Callback s
f, ByteString
-> Seq (Callback s)
-> Map ByteString (Seq (Callback s))
-> Map ByteString (Seq (Callback s))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
pattern Seq (Callback s)
functionQueueNew Map ByteString (Seq (Callback s))
callbacks)
        api1 :: T s
api1 = T s
api0{callbacks :: Map ByteString (Seq (Callback s))
Instance.callbacks = Map ByteString (Seq (Callback s))
callbacksNew}
        empty :: ByteString
empty = ByteString
ByteString.empty
    Either SomeException (CallbackResult s)
callbackResultValue <- IO (CallbackResult s)
-> IO (Either SomeException (CallbackResult s))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO (CallbackResult s)
 -> IO (Either SomeException (CallbackResult s)))
-> IO (CallbackResult s)
-> IO (Either SomeException (CallbackResult s))
forall a b. (a -> b) -> a -> b
$ case RequestType
requestType of
        RequestType
Instance.ASYNC -> do
            Either (Exception s) (Response s)
callbackResultAsyncValue <- IO (Response s) -> IO (Either (Exception s) (Response s))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO (Response s) -> IO (Either (Exception s) (Response s)))
-> IO (Response s) -> IO (Either (Exception s) (Response s))
forall a b. (a -> b) -> a -> b
$
                Callback s
callbackF RequestType
requestType ByteString
name ByteString
pattern
                ByteString
requestInfo ByteString
request Int
timeout Int
priority ByteString
transId Source
pid
                s
state T s
api1
            case Either (Exception s) (Response s)
callbackResultAsyncValue of
                Left (Terminate T s
api2) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
empty, s
state, T s -> T s
forall s. T s -> T s
setTerminate T s
api2)
                Left (ReturnAsync T s
api2) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished T s
api2
                Left (ReturnSync T s
api2) -> do
                    String -> IO ()
printException String
"Synchronous Call Return Invalid"
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished (T s -> T s
forall s. T s -> T s
setTerminate T s
api2)
                Left (ForwardAsync T s
api2) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished T s
api2
                Left (ForwardSync T s
api2) -> do
                    String -> IO ()
printException String
"Synchronous Call Forward Invalid"
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished (T s -> T s
forall s. T s -> T s
setTerminate T s
api2)
                Right (Instance.ResponseInfo (ByteString
v0, ByteString
v1, s
v2, T s
v3)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
v0, ByteString
v1, s
v2, T s
v3)
                Right (Instance.Response (ByteString
v0, s
v1, T s
v2)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
v0, s
v1, T s
v2)
                Right (Instance.Forward (ByteString
v0, ByteString
v1, ByteString
v2, s
v3, T s
v4)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
forall s.
(ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
ForwardI (ByteString
v0, ByteString
v1, ByteString
v2, Int
timeout, Int
priority, s
v3, T s
v4)
                Right (Instance.Forward_ (ByteString
v0, ByteString
v1, ByteString
v2, Int
v3, Int
v4, s
v5, T s
v6)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
forall s.
(ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
ForwardI (ByteString
v0, ByteString
v1, ByteString
v2, Int
v3, Int
v4, s
v5, T s
v6)
                Right (Instance.Null (s
v0, T s
v1)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
empty, s
v0, T s
v1)
                Right (Instance.NullError (String
err, s
v0, T s
v1)) -> do
                    String -> IO ()
printError String
err
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
empty, s
v0, T s
v1)
        RequestType
Instance.SYNC -> do
            Either (Exception s) (Response s)
callbackResultSyncValue <- IO (Response s) -> IO (Either (Exception s) (Response s))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO (Response s) -> IO (Either (Exception s) (Response s)))
-> IO (Response s) -> IO (Either (Exception s) (Response s))
forall a b. (a -> b) -> a -> b
$
                Callback s
callbackF RequestType
requestType ByteString
name ByteString
pattern
                ByteString
requestInfo ByteString
request Int
timeout Int
priority ByteString
transId Source
pid
                s
state T s
api1
            case Either (Exception s) (Response s)
callbackResultSyncValue of
                Left (Terminate T s
api2) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
empty, s
state, T s -> T s
forall s. T s -> T s
setTerminate T s
api2)
                Left (ReturnSync T s
api2) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished T s
api2
                Left (ReturnAsync T s
api2) -> do
                    String -> IO ()
printException String
"Asynchronous Call Return Invalid"
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished (T s -> T s
forall s. T s -> T s
setTerminate T s
api2)
                Left (ForwardSync T s
api2) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished T s
api2
                Left (ForwardAsync T s
api2) -> do
                    String -> IO ()
printException String
"Asynchronous Call Forward Invalid"
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ T s -> CallbackResult s
forall s. T s -> CallbackResult s
Finished (T s -> T s
forall s. T s -> T s
setTerminate T s
api2)
                Right (Instance.ResponseInfo (ByteString
v0, ByteString
v1, s
v2, T s
v3)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
v0, ByteString
v1, s
v2, T s
v3)
                Right (Instance.Response (ByteString
v0, s
v1, T s
v2)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
v0, s
v1, T s
v2)
                Right (Instance.Forward (ByteString
v0, ByteString
v1, ByteString
v2, s
v3, T s
v4)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
forall s.
(ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
ForwardI (ByteString
v0, ByteString
v1, ByteString
v2, Int
timeout, Int
priority, s
v3, T s
v4)
                Right (Instance.Forward_ (ByteString
v0, ByteString
v1, ByteString
v2, Int
v3, Int
v4, s
v5, T s
v6)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
forall s.
(ByteString, ByteString, ByteString, Int, Int, s, T s)
-> CallbackResult s
ForwardI (ByteString
v0, ByteString
v1, ByteString
v2, Int
v3, Int
v4, s
v5, T s
v6)
                Right (Instance.Null (s
v0, T s
v1)) ->
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
empty, s
v0, T s
v1)
                Right (Instance.NullError (String
err, s
v0, T s
v1)) -> do
                    String -> IO ()
printError String
err
                    CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
empty, s
v0, T s
v1)
    CallbackResult s
callbackResultType <- case Either SomeException (CallbackResult s)
callbackResultValue of
        Left SomeException
exception -> do
            SomeException -> IO ()
callbackException SomeException
exception
            CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString, s, T s) -> CallbackResult s
forall s. (ByteString, ByteString, s, T s) -> CallbackResult s
ReturnI (ByteString
empty, ByteString
empty, s
state, T s
api1)
        Right CallbackResult s
callbackResult ->
            CallbackResult s -> IO (CallbackResult s)
forall (m :: * -> *) a. Monad m => a -> m a
return (CallbackResult s -> IO (CallbackResult s))
-> CallbackResult s -> IO (CallbackResult s)
forall a b. (a -> b) -> a -> b
$ CallbackResult s
callbackResult
    case RequestType
requestType of
        RequestType
Instance.ASYNC ->
            case CallbackResult s
callbackResultType of
                Finished T s
api3 ->
                    Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api3
                ReturnI (ByteString
responseInfo, ByteString
response, s
state', T s
api3) ->
                    T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
returnAsyncI T s
api3{state :: s
Instance.state = s
state'}
                        ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid
                ForwardI (ByteString
name', ByteString
requestInfo', ByteString
request', Int
timeout', Int
priority',
                          s
state', T s
api3) ->
                    T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forwardAsyncI T s
api3{state :: s
Instance.state = s
state'}
                        ByteString
name' ByteString
requestInfo' ByteString
request'
                        Int
timeout' Int
priority' ByteString
transId Source
pid
        RequestType
Instance.SYNC ->
            case CallbackResult s
callbackResultType of
                Finished T s
api3 ->
                    Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api3
                ReturnI (ByteString
responseInfo, ByteString
response, s
state', T s
api3) ->
                    T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
returnSyncI T s
api3{state :: s
Instance.state = s
state'}
                        ByteString
name ByteString
pattern ByteString
responseInfo ByteString
response Int
timeout ByteString
transId Source
pid
                ForwardI (ByteString
name', ByteString
requestInfo', ByteString
request', Int
timeout', Int
priority',
                          s
state', T s
api3) ->
                    T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forall s.
T s
-> ByteString
-> ByteString
-> ByteString
-> Int
-> Int
-> ByteString
-> Source
-> IO (Result (T s))
forwardSyncI T s
api3{state :: s
Instance.state = s
state'}
                        ByteString
name' ByteString
requestInfo' ByteString
request'
                        Int
timeout' Int
priority' ByteString
transId Source
pid

handleEvents :: [Message] -> Instance.T s -> Bool -> Word32 ->
    Get ([Message], Instance.T s)
handleEvents :: [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api0 Bool
external Word32
cmd0 = do
    Word32
cmd <- if Word32
cmd0 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 then Get Word32
Get.getWord32host else Word32 -> Get Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
cmd0
    case () of
      ()
_ | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageTerm ->
            if Bool
external then
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], T s -> T s
forall s. T s -> T s
setTerminate T s
api0)
            else
                String -> Get ([Message], T s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
terminateError
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageReinit -> do
            Word32
processCount' <- Get Word32
Get.getWord32host
            Word32
timeoutAsync' <- Get Word32
Get.getWord32host
            Word32
timeoutSync' <- Get Word32
Get.getWord32host
            Int8
priorityDefault' <- Get Int8
Get.getInt8
            let api1 :: T s
api1 = T s -> Word32 -> Word32 -> Word32 -> Int8 -> T s
forall s. T s -> Word32 -> Word32 -> Word32 -> Int8 -> T s
Instance.reinit T s
api0
                    Word32
processCount'
                    Word32
timeoutAsync'
                    Word32
timeoutSync'
                    Int8
priorityDefault'
            Bool
empty <- Get Bool
Get.isEmpty
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api1 Bool
external Word32
0
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messages, T s
api1)
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageKeepalive -> do
            let messagesNew :: [Message]
messagesNew = Message
MessageKeepaliveMessage -> [Message] -> [Message]
forall a. a -> [a] -> [a]
:[Message]
messages
            Bool
empty <- Get Bool
Get.isEmpty
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messagesNew T s
api0 Bool
external Word32
0
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messagesNew, T s
api0)
        | Bool
otherwise ->
            String -> Get ([Message], T s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
messageDecodingError

pollRequestDataGet :: [Message] -> Instance.T s -> Bool ->
    Get ([Message], Instance.T s)
pollRequestDataGet :: [Message] -> T s -> Bool -> Get ([Message], T s)
pollRequestDataGet [Message]
messages T s
api0 Bool
external = do
    Word32
cmd <- Get Word32
Get.getWord32host
    case () of
      ()
_ | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageInit -> do
            Word32
processIndex' <- Get Word32
Get.getWord32host
            Word32
processCount' <- Get Word32
Get.getWord32host
            Word32
processCountMax' <- Get Word32
Get.getWord32host
            Word32
processCountMin' <- Get Word32
Get.getWord32host
            Word32
prefixSize <- Get Word32
Get.getWord32host
            ByteString
prefix' <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
prefixSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            Int -> Get ()
Get.skip Int
1
            Word32
timeoutInitialize' <- Get Word32
Get.getWord32host
            Word32
timeoutAsync' <- Get Word32
Get.getWord32host
            Word32
timeoutSync' <- Get Word32
Get.getWord32host
            Word32
timeoutTerminate' <- Get Word32
Get.getWord32host
            Int8
priorityDefault' <- Get Int8
Get.getInt8
            let api1 :: T s
api1 = T s
-> Word32
-> Word32
-> Word32
-> Word32
-> ByteString
-> Word32
-> Word32
-> Word32
-> Word32
-> Int8
-> T s
forall s.
T s
-> Word32
-> Word32
-> Word32
-> Word32
-> ByteString
-> Word32
-> Word32
-> Word32
-> Word32
-> Int8
-> T s
Instance.init T s
api0
                    Word32
processIndex'
                    Word32
processCount'
                    Word32
processCountMax'
                    Word32
processCountMin'
                    ByteString
prefix'
                    Word32
timeoutInitialize'
                    Word32
timeoutAsync'
                    Word32
timeoutSync'
                    Word32
timeoutTerminate'
                    Int8
priorityDefault'
            Bool
empty <- Get Bool
Get.isEmpty
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api1 Bool
external Word32
0
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messages, T s
api1)
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageSendAsync Bool -> Bool -> Bool
|| Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageSendSync -> do
            Word32
nameSize <- Get Word32
Get.getWord32host
            ByteString
name <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nameSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            Int -> Get ()
Get.skip Int
1
            Word32
patternSize <- Get Word32
Get.getWord32host
            ByteString
pattern <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
patternSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            Int -> Get ()
Get.skip Int
1
            Word32
requestInfoSize <- Get Word32
Get.getWord32host
            ByteString
requestInfo <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
requestInfoSize
            Int -> Get ()
Get.skip Int
1
            Word32
requestSize <- Get Word32
Get.getWord32host
            ByteString
request <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
requestSize
            Int -> Get ()
Get.skip Int
1
            Word32
timeout <- Get Word32
Get.getWord32host
            Int8
priority <- Get Int8
Get.getInt8
            ByteString
transId <- Int -> Get ByteString
Get.getByteString Int
16
            Word32
pidSize <- Get Word32
Get.getWord32host
            LazyByteString
pidData <- Int64 -> Get LazyByteString
Get.getLazyByteString (Int64 -> Get LazyByteString) -> Int64 -> Get LazyByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
pidSize
            Bool
empty <- Get Bool
Get.isEmpty
            case LazyByteString -> Result OtpErlangTerm
Erlang.binaryToTerm LazyByteString
pidData of
                Left Error
err ->
                    String -> Get ([Message], T s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ([Message], T s)) -> String -> Get ([Message], T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
                Right (Erlang.OtpErlangPid (Source
pid)) ->
                    let requestType :: RequestType
requestType =
                            if Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageSendAsync then
                                RequestType
Instance.ASYNC
                            else -- cmd == messageSendSync
                                RequestType
Instance.SYNC
                        messagesNew :: [Message]
messagesNew = ((RequestType, ByteString, ByteString, ByteString, ByteString, Int,
 Int, ByteString, Source)
-> Message
MessageSend (
                            RequestType
requestType, ByteString
name, ByteString
pattern, ByteString
requestInfo, ByteString
request,
                            Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
timeout, Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
priority,
                            ByteString
transId, Source
pid))Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
:[Message]
messages in
                    if Bool -> Bool
not Bool
empty then
                        [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messagesNew T s
api0 Bool
external Word32
0
                    else
                        ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messagesNew, T s
api0)
                Right OtpErlangTerm
_ ->
                    String -> Get ([Message], T s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
messageDecodingError
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageRecvAsync Bool -> Bool -> Bool
|| Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageReturnSync -> do
            Word32
responseInfoSize <- Get Word32
Get.getWord32host
            ByteString
responseInfo <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
responseInfoSize
            Int -> Get ()
Get.skip Int
1
            Word32
responseSize <- Get Word32
Get.getWord32host
            ByteString
response <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
responseSize
            Int -> Get ()
Get.skip Int
1
            ByteString
transId <- Int -> Get ByteString
Get.getByteString Int
16
            Bool
empty <- Get Bool
Get.isEmpty
            let api1 :: T s
api1 = T s -> ByteString -> ByteString -> ByteString -> T s
forall s. T s -> ByteString -> ByteString -> ByteString -> T s
Instance.setResponse T s
api0
                    ByteString
responseInfo ByteString
response ByteString
transId
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api1 Bool
external Word32
0
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messages, T s
api1)
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageReturnAsync -> do
            ByteString
transId <- Int -> Get ByteString
Get.getByteString Int
16
            Bool
empty <- Get Bool
Get.isEmpty
            let api1 :: T s
api1 = T s -> ByteString -> T s
forall s. T s -> ByteString -> T s
Instance.setTransId T s
api0
                    ByteString
transId
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api1 Bool
external Word32
0
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messages, T s
api1)
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageReturnsAsync -> do
            Word32
transIdCount <- Get Word32
Get.getWord32host
            ByteString
transIds <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
transIdCount)
            Bool
empty <- Get Bool
Get.isEmpty
            let api1 :: T s
api1 = T s -> ByteString -> Word32 -> T s
forall s. T s -> ByteString -> Word32 -> T s
Instance.setTransIds T s
api0
                    ByteString
transIds Word32
transIdCount
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api1 Bool
external Word32
0
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messages, T s
api1)
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageSubscribeCount -> do
            Word32
subscribeCount' <- Get Word32
Get.getWord32host
            Bool
empty <- Get Bool
Get.isEmpty
            let api1 :: T s
api1 = T s -> Word32 -> T s
forall s. T s -> Word32 -> T s
Instance.setSubscribeCount T s
api0
                    Word32
subscribeCount'
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api1 Bool
external Word32
0
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messages, T s
api1)
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageTerm ->
            [Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
forall s.
[Message] -> T s -> Bool -> Word32 -> Get ([Message], T s)
handleEvents [Message]
messages T s
api0 Bool
external Word32
cmd
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageReinit -> do
            Word32
processCount' <- Get Word32
Get.getWord32host
            Word32
timeoutAsync' <- Get Word32
Get.getWord32host
            Word32
timeoutSync' <- Get Word32
Get.getWord32host
            Int8
priorityDefault' <- Get Int8
Get.getInt8
            let api1 :: T s
api1 = T s -> Word32 -> Word32 -> Word32 -> Int8 -> T s
forall s. T s -> Word32 -> Word32 -> Word32 -> Int8 -> T s
Instance.reinit T s
api0
                    Word32
processCount'
                    Word32
timeoutAsync'
                    Word32
timeoutSync'
                    Int8
priorityDefault'
            Bool
empty <- Get Bool
Get.isEmpty
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Get ([Message], T s)
forall s. [Message] -> T s -> Bool -> Get ([Message], T s)
pollRequestDataGet [Message]
messages T s
api1 Bool
external
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messages, T s
api1)
        | Word32
cmd Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
messageKeepalive -> do
            let messagesNew :: [Message]
messagesNew = Message
MessageKeepaliveMessage -> [Message] -> [Message]
forall a. a -> [a] -> [a]
:[Message]
messages
            Bool
empty <- Get Bool
Get.isEmpty
            if Bool -> Bool
not Bool
empty then
                [Message] -> T s -> Bool -> Get ([Message], T s)
forall s. [Message] -> T s -> Bool -> Get ([Message], T s)
pollRequestDataGet [Message]
messagesNew T s
api0 Bool
external
            else
                ([Message], T s) -> Get ([Message], T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Message]
messagesNew, T s
api0)
        | Bool
otherwise ->
            String -> Get ([Message], T s)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
messageDecodingError

pollRequestDataProcess :: Typeable s => [Message] -> Instance.T s ->
    IO (Result (Instance.T s))
pollRequestDataProcess :: [Message] -> T s -> IO (Result (T s))
pollRequestDataProcess [] T s
api0 =
    Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right T s
api0
pollRequestDataProcess (Message
message:[Message]
messages) T s
api0 =
    case Message
message of
        MessageSend (RequestType, ByteString, ByteString, ByteString, ByteString, Int,
 Int, ByteString, Source)
callbackData -> do
            Result (T s)
callbackResult <- T s
-> (RequestType, ByteString, ByteString, ByteString, ByteString,
    Int, Int, ByteString, Source)
-> IO (Result (T s))
forall s.
Typeable s =>
T s
-> (RequestType, ByteString, ByteString, ByteString, ByteString,
    Int, Int, ByteString, Source)
-> IO (Result (T s))
callback T s
api0 (RequestType, ByteString, ByteString, ByteString, ByteString, Int,
 Int, ByteString, Source)
callbackData
            case Result (T s)
callbackResult of
                Left String
err ->
                    Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left String
err
                Right T s
api1 ->
                    [Message] -> T s -> IO (Result (T s))
forall s. Typeable s => [Message] -> T s -> IO (Result (T s))
pollRequestDataProcess [Message]
messages T s
api1
        Message
MessageKeepalive ->
            let aliveTerms :: OtpErlangTerm
aliveTerms = ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"keepalive") in
            case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
aliveTerms (-Int
1) of
                Left Error
err ->
                    Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
                Right LazyByteString
aliveBinary -> do
                    T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
aliveBinary
                    [Message] -> T s -> IO (Result (T s))
forall s. Typeable s => [Message] -> T s -> IO (Result (T s))
pollRequestDataProcess [Message]
messages T s
api0

pollRequestData :: Typeable s => Instance.T s -> Bool -> LazyByteString ->
    IO (Result (Instance.T s))
pollRequestData :: T s -> Bool -> LazyByteString -> IO (Result (T s))
pollRequestData T s
api0 Bool
external LazyByteString
dataIn =
    case Get ([Message], T s)
-> LazyByteString
-> Either
     (LazyByteString, Int64, String)
     (LazyByteString, Int64, ([Message], T s))
forall a.
Get a
-> LazyByteString
-> Either
     (LazyByteString, Int64, String) (LazyByteString, Int64, a)
Get.runGetOrFail ([Message] -> T s -> Bool -> Get ([Message], T s)
forall s. [Message] -> T s -> Bool -> Get ([Message], T s)
pollRequestDataGet [] T s
api0 Bool
external) LazyByteString
dataIn of
        Left (LazyByteString
_, Int64
_, String
err) ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left String
err
        Right (LazyByteString
_, Int64
_, ([Message]
messages, T s
api1)) ->
            [Message] -> T s -> IO (Result (T s))
forall s. Typeable s => [Message] -> T s -> IO (Result (T s))
pollRequestDataProcess ([Message] -> [Message]
forall a. [a] -> [a]
List.reverse [Message]
messages) T s
api1

pollRequestLoop :: Typeable s =>
    Instance.T s -> Int -> Bool -> Clock.NominalDiffTime ->
    IO (Result (Bool, Instance.T s))
pollRequestLoop :: T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
pollRequestLoop T s
api0 Int
timeout Bool
external NominalDiffTime
pollTimer = do
    Maybe Bool
inputAvailable <- T s -> Int -> IO (Maybe Bool)
forall s. Typeable s => T s -> Int -> IO (Maybe Bool)
pollWait T s
api0 Int
timeout
    if Maybe Bool
inputAvailable Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False then
        Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ (Bool, T s) -> Result (Bool, T s)
forall a b. b -> Either a b
Right (Bool
True, T s
api0{timeout :: Maybe Bool
Instance.timeout = Maybe Bool
forall a. Maybe a
Nothing})
    else if Maybe Bool
inputAvailable Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
forall a. Maybe a
Nothing then
        let api1 :: T s
api1 = T s
api0{
              terminate :: Bool
Instance.terminate = Bool
True
            , timeout :: Maybe Bool
Instance.timeout = Maybe Bool
forall a. Maybe a
Nothing} in
        Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ (Bool, T s) -> Result (Bool, T s)
forall a b. b -> Either a b
Right (Bool
False, T s
api1)
    else do
        (LazyByteString
dataIn, Int
_, T s
api1) <- T s -> IO (LazyByteString, Int, T s)
forall s. T s -> IO (LazyByteString, Int, T s)
recv T s
api0
        Result (T s)
dataResult <- T s -> Bool -> LazyByteString -> IO (Result (T s))
forall s.
Typeable s =>
T s -> Bool -> LazyByteString -> IO (Result (T s))
pollRequestData T s
api1 Bool
external LazyByteString
dataIn
        case Result (T s)
dataResult of
            Left String
err ->
                Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Bool, T s)
forall a b. a -> Either a b
Left String
err
            Right api2 :: T s
api2@Instance.T{timeout :: forall s. T s -> Maybe Bool
Instance.timeout = Just Bool
result} ->
                Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ (Bool, T s) -> Result (Bool, T s)
forall a b. b -> Either a b
Right (Bool
result, T s
api2{timeout :: Maybe Bool
Instance.timeout = Maybe Bool
forall a. Maybe a
Nothing})
            Right T s
api2 -> do
                (NominalDiffTime
pollTimerNew, Int
timeoutNew) <- if Int
timeout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then
                        (NominalDiffTime, Int) -> IO (NominalDiffTime, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime
0, Int
timeout)
                    else
                        NominalDiffTime -> Int -> IO (NominalDiffTime, Int)
timeoutAdjustmentPoll NominalDiffTime
pollTimer Int
timeout
                if Int
timeout Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
                    Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ (Bool, T s) -> Result (Bool, T s)
forall a b. b -> Either a b
Right (Bool
True, T s
api2{timeout :: Maybe Bool
Instance.timeout = Maybe Bool
forall a. Maybe a
Nothing})
                else
                    T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
pollRequestLoop T s
api2 Int
timeoutNew Bool
external NominalDiffTime
pollTimerNew

pollRequestLoopBegin :: Typeable s =>
    Instance.T s -> Int -> Bool -> Clock.NominalDiffTime ->
    IO (Result (Bool, Instance.T s))
pollRequestLoopBegin :: T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
pollRequestLoopBegin T s
api0 Int
timeout Bool
external NominalDiffTime
pollTimer = do
    Either SomeException (Result (Bool, T s))
result <- IO (Result (Bool, T s))
-> IO (Either SomeException (Result (Bool, T s)))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
pollRequestLoop T s
api0 Int
timeout Bool
external NominalDiffTime
pollTimer)
    case Either SomeException (Result (Bool, T s))
result of
        Left SomeException
exception ->
            Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Bool, T s)
forall a b. a -> Either a b
Left (String -> Result (Bool, T s)) -> String -> Result (Bool, T s)
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
exception :: SomeException)
        Right Result (Bool, T s)
success ->
            Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return Result (Bool, T s)
success

pollRequest :: Typeable s => Instance.T s -> Int -> Bool ->
    IO (Result (Bool, Instance.T s))
pollRequest :: T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest api0 :: T s
api0@Instance.T{
      initializationComplete :: forall s. T s -> Bool
Instance.initializationComplete = Bool
initializationComplete
    , terminate :: forall s. T s -> Bool
Instance.terminate = Bool
terminate} Int
timeout Bool
external =
    if Bool
terminate then
        if Bool
external then
            Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ (Bool, T s) -> Result (Bool, T s)
forall a b. b -> Either a b
Right (Bool
False, T s
api0)
        else
            Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Bool, T s)
forall a b. a -> Either a b
Left String
terminateError
    else do
        NominalDiffTime
pollTimer <- if Int
timeout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then
                NominalDiffTime -> IO NominalDiffTime
forall (m :: * -> *) a. Monad m => a -> m a
return NominalDiffTime
0
            else
                IO NominalDiffTime
POSIX.getPOSIXTime
        if Bool
external Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
initializationComplete then
            let pollingTerms :: OtpErlangTerm
pollingTerms = ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"polling") in
            case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
pollingTerms (-Int
1) of
                Left Error
err ->
                    Result (Bool, T s) -> IO (Result (Bool, T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (Bool, T s) -> IO (Result (Bool, T s)))
-> Result (Bool, T s) -> IO (Result (Bool, T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (Bool, T s)
forall a b. a -> Either a b
Left (String -> Result (Bool, T s)) -> String -> Result (Bool, T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
                Right LazyByteString
pollingBinary -> do
                    T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
pollingBinary
                    T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
pollRequestLoopBegin
                        T s
api0{initializationComplete :: Bool
Instance.initializationComplete = Bool
True}
                        Int
timeout Bool
external NominalDiffTime
pollTimer
        else
            T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> NominalDiffTime -> IO (Result (Bool, T s))
pollRequestLoopBegin T s
api0 Int
timeout Bool
external NominalDiffTime
pollTimer

pollWait :: Typeable s => Instance.T s -> Int -> IO (Maybe Bool)
pollWait :: T s -> Int -> IO (Maybe Bool)
pollWait Instance.T{
      socketHandle :: forall s. T s -> Handle
Instance.socketHandle = Handle
socketHandle
    , bufferRecvSize :: forall s. T s -> Int
Instance.bufferRecvSize = Int
bufferRecvSize}
    Int
timeout = do
    if Int
bufferRecvSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then
        Maybe Bool -> IO (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    else
        IO (Maybe Bool) -> (IOError -> IO (Maybe Bool)) -> IO (Maybe Bool)
forall a. IO a -> (IOError -> IO a) -> IO a
SysIOErr.catchIOError
            (do
             Bool
inputAvailable <- Handle -> Int -> IO Bool
SysIO.hWaitForInput Handle
socketHandle Int
timeout
             Maybe Bool -> IO (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bool -> IO (Maybe Bool)) -> Maybe Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
inputAvailable)
            (\IOError
e -> if IOError -> Bool
SysIOErr.isEOFError IOError
e then
                 Maybe Bool -> IO (Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bool
forall a. Maybe a
Nothing
             else
                 IOError -> IO (Maybe Bool)
forall a. IOError -> IO a
SysIOErr.ioError IOError
e)

-- | blocks to process incoming CloudI service requests
poll :: Typeable s => Instance.T s -> Int -> IO (Result (Bool, Instance.T s))
poll :: T s -> Int -> IO (Result (Bool, T s))
poll T s
api0 Int
timeout =
    T s -> Int -> Bool -> IO (Result (Bool, T s))
forall s.
Typeable s =>
T s -> Int -> Bool -> IO (Result (Bool, T s))
pollRequest T s
api0 Int
timeout Bool
True

-- | shutdown the service successfully
shutdown :: Instance.T s -> Maybe ByteString ->
    IO (Result (Instance.T s))
shutdown :: T s -> Maybe ByteString -> IO (Result (T s))
shutdown T s
api0 Maybe ByteString
reasonOpt =
    let reason :: ByteString
reason = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
Char8.empty Maybe ByteString
reasonOpt
        shutdownTerms :: OtpErlangTerm
shutdownTerms = [OtpErlangTerm] -> OtpErlangTerm
Erlang.OtpErlangTuple
            [ ByteString -> OtpErlangTerm
Erlang.OtpErlangAtom (String -> ByteString
Char8.pack String
"shutdown")
            , ByteString -> OtpErlangTerm
Erlang.OtpErlangString ByteString
reason]
    in
    case OtpErlangTerm -> Int -> Result LazyByteString
Erlang.termToBinary OtpErlangTerm
shutdownTerms (-Int
1) of
        Left Error
err ->
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ String -> Result (T s)
forall a b. a -> Either a b
Left (String -> Result (T s)) -> String -> Result (T s)
forall a b. (a -> b) -> a -> b
$ Error -> String
forall a. Show a => a -> String
show Error
err
        Right LazyByteString
shutdownBinary -> do
            T s -> LazyByteString -> IO ()
forall s. T s -> LazyByteString -> IO ()
send T s
api0 LazyByteString
shutdownBinary
            Result (T s) -> IO (Result (T s))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result (T s) -> IO (Result (T s)))
-> Result (T s) -> IO (Result (T s))
forall a b. (a -> b) -> a -> b
$ T s -> Result (T s)
forall a b. b -> Either a b
Right (T s -> Result (T s)) -> T s -> Result (T s)
forall a b. (a -> b) -> a -> b
$ T s
api0

send :: Instance.T s -> LazyByteString -> IO ()
send :: T s -> LazyByteString -> IO ()
send Instance.T{
      useHeader :: forall s. T s -> Bool
Instance.useHeader = Bool
True
    , socketHandle :: forall s. T s -> Handle
Instance.socketHandle = Handle
socketHandle} LazyByteString
binary = do
    let total :: Word32
total = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LazyByteString -> Int64
LazyByteString.length LazyByteString
binary) :: Word32
    Handle -> LazyByteString -> IO ()
LazyByteString.hPut Handle
socketHandle (Builder -> LazyByteString
Builder.toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
forall a b. (a -> b) -> a -> b
$
        Word32 -> Builder
Builder.word32BE Word32
total Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`Monoid.mappend`
        LazyByteString -> Builder
Builder.lazyByteString LazyByteString
binary)
send Instance.T{
      useHeader :: forall s. T s -> Bool
Instance.useHeader = Bool
False
    , socketHandle :: forall s. T s -> Handle
Instance.socketHandle = Handle
socketHandle} LazyByteString
binary = do
    Handle -> LazyByteString -> IO ()
LazyByteString.hPut Handle
socketHandle LazyByteString
binary

recvBuffer :: Builder -> Int -> Int -> Handle -> Int ->
    IO (Builder, Int)
recvBuffer :: Builder -> Int -> Int -> Handle -> Int -> IO (Builder, Int)
recvBuffer Builder
bufferRecv Int
bufferRecvSize Int
recvSize Handle
socketHandle Int
bufferSize
    | Int
recvSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bufferRecvSize =
        (Builder, Int) -> IO (Builder, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder
bufferRecv, Int
bufferRecvSize)
    | Bool
otherwise = do
        ByteString
fragment <- Handle -> Int -> IO ByteString
ByteString.hGetNonBlocking Handle
socketHandle Int
bufferSize
        Builder -> Int -> Int -> Handle -> Int -> IO (Builder, Int)
recvBuffer
            (Builder
bufferRecv Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`Monoid.mappend` ByteString -> Builder
Builder.byteString ByteString
fragment)
            (Int
bufferRecvSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
ByteString.length ByteString
fragment)
            Int
recvSize Handle
socketHandle Int
bufferSize

recvBufferAll :: Builder -> Int -> Handle -> Int ->
    IO (Builder, Int)
recvBufferAll :: Builder -> Int -> Handle -> Int -> IO (Builder, Int)
recvBufferAll Builder
bufferRecv Int
bufferRecvSize Handle
socketHandle Int
bufferSize = do
    ByteString
fragment <- Handle -> Int -> IO ByteString
ByteString.hGetNonBlocking Handle
socketHandle Int
bufferSize
    let fragmentSize :: Int
fragmentSize = ByteString -> Int
ByteString.length ByteString
fragment
        bufferRecvNew :: Builder
bufferRecvNew = Builder
bufferRecv Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`Monoid.mappend` ByteString -> Builder
Builder.byteString ByteString
fragment
        bufferRecvSizeNew :: Int
bufferRecvSizeNew = Int
bufferRecvSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fragmentSize
    if Int
fragmentSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bufferSize then
        Builder -> Int -> Handle -> Int -> IO (Builder, Int)
recvBufferAll Builder
bufferRecvNew Int
bufferRecvSizeNew Handle
socketHandle Int
bufferSize
    else
        (Builder, Int) -> IO (Builder, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder
bufferRecv, Int
bufferRecvSize)

recv :: Instance.T s -> IO (LazyByteString, Int, Instance.T s)
recv :: T s -> IO (LazyByteString, Int, T s)
recv api0 :: T s
api0@Instance.T{
      useHeader :: forall s. T s -> Bool
Instance.useHeader = Bool
True
    , socketHandle :: forall s. T s -> Handle
Instance.socketHandle = Handle
socketHandle
    , bufferSize :: forall s. T s -> Int
Instance.bufferSize = Int
bufferSize
    , bufferRecv :: forall s. T s -> Builder
Instance.bufferRecv = Builder
bufferRecv
    , bufferRecvSize :: forall s. T s -> Int
Instance.bufferRecvSize = Int
bufferRecvSize} = do
    (Builder
bufferRecvHeader, Int
bufferRecvHeaderSize) <- Builder -> Int -> Int -> Handle -> Int -> IO (Builder, Int)
recvBuffer
        Builder
bufferRecv Int
bufferRecvSize Int
4 Handle
socketHandle Int
bufferSize
    let header0 :: LazyByteString
header0 = Builder -> LazyByteString
Builder.toLazyByteString Builder
bufferRecvHeader
        Just (Word8
byte0, LazyByteString
header1) = LazyByteString -> Maybe (Word8, LazyByteString)
LazyByteString.uncons LazyByteString
header0
        Just (Word8
byte1, LazyByteString
header2) = LazyByteString -> Maybe (Word8, LazyByteString)
LazyByteString.uncons LazyByteString
header1
        Just (Word8
byte2, LazyByteString
header3) = LazyByteString -> Maybe (Word8, LazyByteString)
LazyByteString.uncons LazyByteString
header2
        Just (Word8
byte3, LazyByteString
headerRemaining) = LazyByteString -> Maybe (Word8, LazyByteString)
LazyByteString.uncons LazyByteString
header3
        total :: Int
total = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$
            (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte0 :: Word32) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
            (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte1 :: Word32) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
            (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte2 :: Word32) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
            (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte3 :: Word32) :: Int
    (Builder
bufferRecvAll, Int
bufferRecvAllSize) <- Builder -> Int -> Int -> Handle -> Int -> IO (Builder, Int)
recvBuffer
        (LazyByteString -> Builder
Builder.lazyByteString LazyByteString
headerRemaining)
        (Int
bufferRecvHeaderSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int
total Handle
socketHandle Int
bufferSize
    let bufferRecvAllStr :: LazyByteString
bufferRecvAllStr = Builder -> LazyByteString
Builder.toLazyByteString Builder
bufferRecvAll
        (LazyByteString
bufferRecvData, LazyByteString
bufferRecvNew) =
            Int64 -> LazyByteString -> (LazyByteString, LazyByteString)
LazyByteString.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total) LazyByteString
bufferRecvAllStr
    (LazyByteString, Int, T s) -> IO (LazyByteString, Int, T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((LazyByteString, Int, T s) -> IO (LazyByteString, Int, T s))
-> (LazyByteString, Int, T s) -> IO (LazyByteString, Int, T s)
forall a b. (a -> b) -> a -> b
$ (
          LazyByteString
bufferRecvData
        , Int
total
        , T s
api0{
              bufferRecv :: Builder
Instance.bufferRecv = LazyByteString -> Builder
Builder.lazyByteString LazyByteString
bufferRecvNew
            , bufferRecvSize :: Int
Instance.bufferRecvSize = Int
bufferRecvAllSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
total})
recv api0 :: T s
api0@Instance.T{
      useHeader :: forall s. T s -> Bool
Instance.useHeader = Bool
False
    , socketHandle :: forall s. T s -> Handle
Instance.socketHandle = Handle
socketHandle
    , bufferSize :: forall s. T s -> Int
Instance.bufferSize = Int
bufferSize
    , bufferRecv :: forall s. T s -> Builder
Instance.bufferRecv = Builder
bufferRecv
    , bufferRecvSize :: forall s. T s -> Int
Instance.bufferRecvSize = Int
bufferRecvSize} = do
    (Builder
bufferRecvAll,
     Int
bufferRecvAllSize) <- Builder -> Int -> Handle -> Int -> IO (Builder, Int)
recvBufferAll
        Builder
bufferRecv Int
bufferRecvSize Handle
socketHandle Int
bufferSize
    (LazyByteString, Int, T s) -> IO (LazyByteString, Int, T s)
forall (m :: * -> *) a. Monad m => a -> m a
return ((LazyByteString, Int, T s) -> IO (LazyByteString, Int, T s))
-> (LazyByteString, Int, T s) -> IO (LazyByteString, Int, T s)
forall a b. (a -> b) -> a -> b
$ (
          Builder -> LazyByteString
Builder.toLazyByteString Builder
bufferRecvAll
        , Int
bufferRecvAllSize
        , T s
api0{
              bufferRecv :: Builder
Instance.bufferRecv = Builder
forall a. Monoid a => a
Monoid.mempty
            , bufferRecvSize :: Int
Instance.bufferRecvSize = Int
0})

timeoutAdjustmentPoll :: Clock.NominalDiffTime -> Int ->
    IO (Clock.NominalDiffTime, Int)
timeoutAdjustmentPoll :: NominalDiffTime -> Int -> IO (NominalDiffTime, Int)
timeoutAdjustmentPoll NominalDiffTime
t0 Int
timeout = do
    NominalDiffTime
t1 <- IO NominalDiffTime
POSIX.getPOSIXTime
    if NominalDiffTime
t1 NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= NominalDiffTime
t0 then
        (NominalDiffTime, Int) -> IO (NominalDiffTime, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime
t1, Int
timeout)
    else
        let elapsed :: Integer
elapsed = NominalDiffTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ((NominalDiffTime
t1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
t0) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
1000) :: Integer
            timeoutValue :: Integer
timeoutValue = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
timeout :: Integer in
        if Integer
elapsed Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
timeoutValue then
            (NominalDiffTime, Int) -> IO (NominalDiffTime, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime
t1, Int
0)
        else
            (NominalDiffTime, Int) -> IO (NominalDiffTime, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime
t1, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Integer
timeoutValue Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
elapsed)

setTerminate :: Instance.T s -> Instance.T s
setTerminate :: T s -> T s
setTerminate T s
api0 =
    T s
api0{ terminate :: Bool
Instance.terminate = Bool
True
        , timeout :: Maybe Bool
Instance.timeout = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False}

threadList :: Concurrent.MVar [Concurrent.MVar ()]
threadList :: MVar [MVar ()]
threadList = IO (MVar [MVar ()]) -> MVar [MVar ()]
forall a. IO a -> a
Unsafe.unsafePerformIO ([MVar ()] -> IO (MVar [MVar ()])
forall a. a -> IO (MVar a)
Concurrent.newMVar [])

-- | simplifies thread creation and join
--
-- > Concurrent.setNumCapabilities threadCount
-- > mapM_ (CloudI.threadCreate task) [0..threadCount - 1]
-- > CloudI.threadsWait
threadCreate :: (Int -> IO ()) -> Int -> IO ThreadId
threadCreate :: (Int -> IO ()) -> Int -> IO ThreadId
threadCreate Int -> IO ()
f Int
threadIndex = do
    MVar ()
thread <- IO (MVar ())
forall a. IO (MVar a)
Concurrent.newEmptyMVar
    [MVar ()]
threads <- MVar [MVar ()] -> IO [MVar ()]
forall a. MVar a -> IO a
Concurrent.takeMVar MVar [MVar ()]
threadList
    MVar [MVar ()] -> [MVar ()] -> IO ()
forall a. MVar a -> a -> IO ()
Concurrent.putMVar MVar [MVar ()]
threadList (MVar ()
threadMVar () -> [MVar ()] -> [MVar ()]
forall a. a -> [a] -> [a]
:[MVar ()]
threads)
    Int -> IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
forall a.
Int -> IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
threadCreateFork Int
threadIndex (Int -> IO ()
f Int
threadIndex)
        (\Either SomeException ()
_ -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
Concurrent.putMVar MVar ()
thread ())

threadCreateFork :: Int -> IO a -> (Either SomeException a -> IO ()) ->
    IO ThreadId
threadCreateFork :: Int -> IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
threadCreateFork Int
threadIndex IO a
action Either SomeException a -> IO ()
afterF =
    -- similar to Concurrent.forkFinally
    ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore ->
        Int -> IO () -> IO ThreadId
Concurrent.forkOn Int
threadIndex
            (IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO a -> IO a
forall a. IO a -> IO a
restore IO a
action) IO (Either SomeException a)
-> (Either SomeException a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException a -> IO ()
afterF)

-- | wait for threads to join after being created by 'threadCreate'
threadsWait :: IO ()
threadsWait :: IO ()
threadsWait = do
    [MVar ()]
threads <- MVar [MVar ()] -> IO [MVar ()]
forall a. MVar a -> IO a
Concurrent.takeMVar MVar [MVar ()]
threadList
    case [MVar ()]
threads of
        [] ->
            () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        MVar ()
done:[MVar ()]
remaining -> do
            MVar [MVar ()] -> [MVar ()] -> IO ()
forall a. MVar a -> a -> IO ()
Concurrent.putMVar MVar [MVar ()]
threadList [MVar ()]
remaining
            MVar () -> IO ()
forall a. MVar a -> IO a
Concurrent.takeMVar MVar ()
done
            IO ()
threadsWait

textPairsParse :: ByteString -> Map ByteString [ByteString]
textPairsParse :: ByteString -> Map ByteString [ByteString]
textPairsParse ByteString
text =
    let loop :: Map ByteString [ByteString]
-> [ByteString] -> Map ByteString [ByteString]
loop Map ByteString [ByteString]
m [] = Map ByteString [ByteString]
m
        loop Map ByteString [ByteString]
m [ByteString
v] =
            if ByteString
v ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
ByteString.empty then
                Map ByteString [ByteString]
m
            else
                String -> Map ByteString [ByteString]
forall a. HasCallStack => String -> a
error String
"not text_pairs"
        loop Map ByteString [ByteString]
m (ByteString
k:(ByteString
v:[ByteString]
l')) =
            case ByteString -> Map ByteString [ByteString] -> Maybe [ByteString]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
k Map ByteString [ByteString]
m of
                Maybe [ByteString]
Nothing ->
                    Map ByteString [ByteString]
-> [ByteString] -> Map ByteString [ByteString]
loop (ByteString
-> [ByteString]
-> Map ByteString [ByteString]
-> Map ByteString [ByteString]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
k [ByteString
v] Map ByteString [ByteString]
m) [ByteString]
l'
                Just [ByteString]
v' ->
                    Map ByteString [ByteString]
-> [ByteString] -> Map ByteString [ByteString]
loop (ByteString
-> [ByteString]
-> Map ByteString [ByteString]
-> Map ByteString [ByteString]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
k ([ByteString]
v' [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
v]) Map ByteString [ByteString]
m) [ByteString]
l'
    in
    Map ByteString [ByteString]
-> [ByteString] -> Map ByteString [ByteString]
loop Map ByteString [ByteString]
forall k a. Map k a
Map.empty (Char -> ByteString -> [ByteString]
Char8.split Char
'\0' ByteString
text)

textPairsNew :: Map ByteString [ByteString] -> Maybe Bool -> ByteString
textPairsNew :: Map ByteString [ByteString] -> Maybe Bool -> ByteString
textPairsNew Map ByteString [ByteString]
pairs Maybe Bool
responseOpt =
    let response :: Bool
response = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
responseOpt in
    if Bool
response Bool -> Bool -> Bool
&& Map ByteString [ByteString] -> Int
forall k a. Map k a -> Int
Map.size Map ByteString [ByteString]
pairs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
        String -> ByteString
Char8.pack String
"\0"
    else
        let pair :: Builder -> ByteString -> [ByteString] -> Builder
pair Builder
builder ByteString
_ [] =
                Builder
builder
            pair Builder
builder ByteString
k (ByteString
v:[ByteString]
l') =
                Builder -> ByteString -> [ByteString] -> Builder
pair (Builder
builder Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
<>
                    ByteString -> Builder
Builder.byteString ByteString
k Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
'\0' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
<>
                    ByteString -> Builder
Builder.byteString ByteString
v Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
<> Char -> Builder
Builder.char8 Char
'\0') ByteString
k [ByteString]
l'
        in
        LazyByteString -> ByteString
LazyByteString.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> LazyByteString
Builder.toLazyByteString (Builder -> LazyByteString) -> Builder -> LazyByteString
forall a b. (a -> b) -> a -> b
$
            (Builder -> ByteString -> [ByteString] -> Builder)
-> Builder -> Map ByteString [ByteString] -> Builder
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey Builder -> ByteString -> [ByteString] -> Builder
pair Builder
forall a. Monoid a => a
Monoid.mempty Map ByteString [ByteString]
pairs

-- | decode service request info key/value data
infoKeyValueParse :: ByteString -> Map ByteString [ByteString]
infoKeyValueParse :: ByteString -> Map ByteString [ByteString]
infoKeyValueParse = ByteString -> Map ByteString [ByteString]
textPairsParse

-- | encode service response info key/value data
infoKeyValueNew :: Map ByteString [ByteString] -> Maybe Bool -> ByteString
infoKeyValueNew :: Map ByteString [ByteString] -> Maybe Bool -> ByteString
infoKeyValueNew = Map ByteString [ByteString] -> Maybe Bool -> ByteString
textPairsNew