{-# LINE 1 "src/GHC/Eventlog/Socket.hsc" #-}
{-|
Module      : GHC.Eventlog.Socket
Description : Haskell API for @eventlog-socket@.
Stability   : experimental
Portability : POSIX

This module exports the Haskell API for @eventlog-socket@.

To start streaming GHC eventlog events to a socket, use `startWith` with a [socket address](#t:EventlogSocketAddr) and [options](#t:EventlogSocketOpts).
For instance, the following code starts @eventlog-socket@ configured to wait for a connection and then stream events to @\/tmp\/my_app.sock@.

@
let addr = `EventlogSocketUnixAddr` "\/tmp\/my_app.sock"
let opts = `defaultEventlogSocketOpts` {`esoWait` = True}
`startWith` addr opts
@

To register custom control commands, use `registerNamespace` and `registerCommand`.
For instance, the following code registers the namespace @"ping"@ with one command at ID 1 that prints "Ping!" when called.

@
pingNamespace <- `registerNamespace` "ping"
let pingId = v`CommandId` 1
let pingHandler = putStrLn "Ping!"
`registerCommand` pingNamespace pingId pingHandler
@
-}

{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeApplications #-}

module GHC.Eventlog.Socket (
    -- * High-level API #high_level_api#
    startWith,

    -- ** Configuration types #configuration_types#
    EventlogSocketAddr (..),
    EventlogSocketOpts (esoWait, esoSndbuf, esoLinger),
    defaultEventlogSocketOpts,

    -- ** Configuration via environment #configuration_via_environment#
    startFromEnv,
    fromEnv,
    EventlogSocketAddrError(..),

    -- ** Hooks #hooks#
    Hook (
        HookPostStartEventLogging,
        HookPreEndEventLogging
    ),
    HookHandler,
    registerHook,

    -- ** Control commands #control_commands#
    Namespace,
    CommandId(..),
    CommandHandler,
    namespaceName,
    registerNamespace,
    registerCommand,
    EventlogSocketControlError(..),

    -- ** Low-level API #low_level_api#
    testWorkerStatus,
    testControlStatus,

    -- * Legacy API #legacy_api#
    startWait,
    start,
    wait,
) where

import Control.Exception (AssertionFailed (..), Exception (..), assert, bracket, bracket_, bracketOnError, throwIO)
import Control.Monad((<=<), when)
import Data.Foldable (traverse_)
import Data.Function ((&))
import Data.Int (Int32)
import Data.Maybe (fromMaybe)
import Data.Void (Void, vacuous)
import Data.Word (Word8, Word32)
import Foreign.C (CBool (..))
import Foreign.C.String (CString, peekCString, withCString, withCStringLen)
import Foreign.Ptr (FunPtr, freeHaskellFunPtr, Ptr, castPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable (..))
import Foreign.Marshal.Alloc (alloca, allocaBytes, free)
import Foreign.Marshal.Utils (fromBool, toBool, with)
import GHC.Enum (toEnumError)
import System.IO.Unsafe (unsafePerformIO)




--------------------------------------------------------------------------------
-- High-level API
--------------------------------------------------------------------------------

{- |
Start an @eventlog-socket@ writer using the given socket address and options.

@since 0.1.2.0
-}
startWith ::
    EventlogSocketAddr ->
    EventlogSocketOpts ->
    IO ()
startWith :: EventlogSocketAddr -> EventlogSocketOpts -> IO ()
startWith EventlogSocketAddr
esa EventlogSocketOpts
eso =
    Int -> (Ptr EventlogSocketStatus -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8) ((Ptr EventlogSocketStatus -> IO ()) -> IO ())
-> (Ptr EventlogSocketStatus -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketStatus
essPtr -> do
{-# LINE 110 "src/GHC/Eventlog/Socket.hsc" #-}
        EventlogSocketAddr -> (Ptr EventlogSocketAddr -> IO ()) -> IO ()
forall a.
EventlogSocketAddr -> (Ptr EventlogSocketAddr -> IO a) -> IO a
withEventlogSocketAddr EventlogSocketAddr
esa ((Ptr EventlogSocketAddr -> IO ()) -> IO ())
-> (Ptr EventlogSocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketAddr
esaPtr ->
            EventlogSocketOpts -> (Ptr EventlogSocketOpts -> IO ()) -> IO ()
forall a.
EventlogSocketOpts -> (Ptr EventlogSocketOpts -> IO a) -> IO a
withEventlogSocketOpts EventlogSocketOpts
eso ((Ptr EventlogSocketOpts -> IO ()) -> IO ())
-> (Ptr EventlogSocketOpts -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketOpts
esoPtr ->
                Ptr EventlogSocketStatus
-> Ptr EventlogSocketAddr -> Ptr EventlogSocketOpts -> IO ()
eventlog_socket_start Ptr EventlogSocketStatus
essPtr Ptr EventlogSocketAddr
esaPtr Ptr EventlogSocketOpts
esoPtr
        status <- Ptr EventlogSocketStatus -> IO EventlogSocketStatus
peekEventlogSocketStatus Ptr EventlogSocketStatus
essPtr

        -- If the status is an error, throw a user error.
        when (essStatusCode status /= EVENTLOG_SOCKET_OK) $
            vacuous $ throwEventlogSocketStatus essPtr

--------------------------------------------------------------------------------
-- Configuration types

{- |
A type representing the supported eventlog socket modes.

@since 0.1.2.0
-}
data
    {-# CTYPE "eventlog_socket.h" "EventlogSocketAddr" #-}
    EventlogSocketAddr = EventlogSocketUnixAddr
        { EventlogSocketAddr -> FilePath
esaUnixPath :: FilePath
        -- ^ Unix socket path, e.g., @"\/tmp\/ghc_eventlog.sock"@.
        --
        --         __Warning:__ Unix domain socket paths are often limited to 107 characters or less.
        }
    | EventlogSocketInetAddr
        { EventlogSocketAddr -> FilePath
esaInetHost :: String
        -- ^ TCP host or interface, e.g. @"127.0.0.1"@.
        , EventlogSocketAddr -> FilePath
esaInetPort :: String
        -- ^ TCP port, e.g., @"4242"@.
        }
    deriving (EventlogSocketAddr -> EventlogSocketAddr -> Bool
(EventlogSocketAddr -> EventlogSocketAddr -> Bool)
-> (EventlogSocketAddr -> EventlogSocketAddr -> Bool)
-> Eq EventlogSocketAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventlogSocketAddr -> EventlogSocketAddr -> Bool
== :: EventlogSocketAddr -> EventlogSocketAddr -> Bool
$c/= :: EventlogSocketAddr -> EventlogSocketAddr -> Bool
/= :: EventlogSocketAddr -> EventlogSocketAddr -> Bool
Eq, Int -> EventlogSocketAddr -> ShowS
[EventlogSocketAddr] -> ShowS
EventlogSocketAddr -> FilePath
(Int -> EventlogSocketAddr -> ShowS)
-> (EventlogSocketAddr -> FilePath)
-> ([EventlogSocketAddr] -> ShowS)
-> Show EventlogSocketAddr
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventlogSocketAddr -> ShowS
showsPrec :: Int -> EventlogSocketAddr -> ShowS
$cshow :: EventlogSocketAddr -> FilePath
show :: EventlogSocketAddr -> FilePath
$cshowList :: [EventlogSocketAddr] -> ShowS
showList :: [EventlogSocketAddr] -> ShowS
Show)

{- |
The socket options for @eventlog-socket@.

To construct an instance of the socket options, use `defaultEventlogSocketOpts` and the fields.
For instance:

@
myEventlogSocketOpts :: EventlogSocketOpts
myEventlogSocketOpts = defaultEventlogSocketOpts
    { esoWait = True
    }
@

The following socket options are available:

[@`esoWait` :: `Bool`@ #v:esoWait#]:
Whether or not to wait for a client to connect.

[@`esoSndbuf` ~ `Foreign.C.Types.CInt`@ #v:esoSndbuf#]:
    The size of the socket send buffer.

    See the documentation for @SO_SNDBUF@ in @socket.h@.

[@`esoLinger` ~ `Foreign.C.Types.CInt`@ #v:esoLinger#]:
    The number of seconds to linger on shutdown.

    See the documentation for @SO_LINGER@ in @socket.h@.

@since 0.1.2.0
-}
data
    {-# CTYPE "eventlog_socket.h" "EventlogSocketOpts" #-}
    EventlogSocketOpts = EventlogSocketOpts
        { EventlogSocketOpts -> Bool
esoWait :: Bool
        , EventlogSocketOpts -> Maybe Int32
esoSndbuf :: Maybe Int32
{-# LINE 178 "src/GHC/Eventlog/Socket.hsc" #-}
        , EventlogSocketOpts -> Maybe Int32
esoLinger :: Maybe Int32
{-# LINE 179 "src/GHC/Eventlog/Socket.hsc" #-}
        }
    deriving (EventlogSocketOpts -> EventlogSocketOpts -> Bool
(EventlogSocketOpts -> EventlogSocketOpts -> Bool)
-> (EventlogSocketOpts -> EventlogSocketOpts -> Bool)
-> Eq EventlogSocketOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventlogSocketOpts -> EventlogSocketOpts -> Bool
== :: EventlogSocketOpts -> EventlogSocketOpts -> Bool
$c/= :: EventlogSocketOpts -> EventlogSocketOpts -> Bool
/= :: EventlogSocketOpts -> EventlogSocketOpts -> Bool
Eq, Int -> EventlogSocketOpts -> ShowS
[EventlogSocketOpts] -> ShowS
EventlogSocketOpts -> FilePath
(Int -> EventlogSocketOpts -> ShowS)
-> (EventlogSocketOpts -> FilePath)
-> ([EventlogSocketOpts] -> ShowS)
-> Show EventlogSocketOpts
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventlogSocketOpts -> ShowS
showsPrec :: Int -> EventlogSocketOpts -> ShowS
$cshow :: EventlogSocketOpts -> FilePath
show :: EventlogSocketOpts -> FilePath
$cshowList :: [EventlogSocketOpts] -> ShowS
showList :: [EventlogSocketOpts] -> ShowS
Show)

{- |
The default socket options for @eventlog-socket@.

See t`EventlogSocketOpts`.

@since 0.1.2.0
-}
defaultEventlogSocketOpts :: EventlogSocketOpts
defaultEventlogSocketOpts :: EventlogSocketOpts
defaultEventlogSocketOpts =
    IO EventlogSocketOpts -> EventlogSocketOpts
forall a. IO a -> a
unsafePerformIO (IO EventlogSocketOpts -> EventlogSocketOpts)
-> IO EventlogSocketOpts -> EventlogSocketOpts
forall a b. (a -> b) -> a -> b
$
        Int
-> (Ptr EventlogSocketOpts -> IO EventlogSocketOpts)
-> IO EventlogSocketOpts
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
12) ((Ptr EventlogSocketOpts -> IO EventlogSocketOpts)
 -> IO EventlogSocketOpts)
-> (Ptr EventlogSocketOpts -> IO EventlogSocketOpts)
-> IO EventlogSocketOpts
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketOpts
esoPtr ->
{-# LINE 193 "src/GHC/Eventlog/Socket.hsc" #-}
            IO () -> IO () -> IO EventlogSocketOpts -> IO EventlogSocketOpts
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
                (Ptr EventlogSocketOpts -> IO ()
eventlog_socket_opts_init Ptr EventlogSocketOpts
esoPtr)
                (Ptr EventlogSocketOpts -> IO ()
eventlog_socket_opts_free Ptr EventlogSocketOpts
esoPtr)
                (Ptr EventlogSocketOpts -> IO EventlogSocketOpts
peekEventlogSocketOpts Ptr EventlogSocketOpts
esoPtr)

--------------------------------------------------------------------------------
-- Configuration via environment

{- |
Read the eventlog socket configuration from the environment.
If this succeeds, start an @eventlog-socket@ writer with that configuration.

@since 0.1.2.0
-}
startFromEnv :: IO ()
startFromEnv :: IO ()
startFromEnv = IO (Maybe (EventlogSocketAddr, EventlogSocketOpts))
fromEnv IO (Maybe (EventlogSocketAddr, EventlogSocketOpts))
-> (Maybe (EventlogSocketAddr, EventlogSocketOpts) -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((EventlogSocketAddr, EventlogSocketOpts) -> IO ())
-> Maybe (EventlogSocketAddr, EventlogSocketOpts) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((EventlogSocketAddr -> EventlogSocketOpts -> IO ())
-> (EventlogSocketAddr, EventlogSocketOpts) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry EventlogSocketAddr -> EventlogSocketOpts -> IO ()
startWith)

{- |
Read the eventlog socket configuration from the environment.

@since 0.1.2.0
-}
fromEnv ::
    IO (Maybe (EventlogSocketAddr, EventlogSocketOpts))
fromEnv :: IO (Maybe (EventlogSocketAddr, EventlogSocketOpts))
fromEnv =
    Int
-> (Ptr EventlogSocketAddr
    -> IO (Maybe (EventlogSocketAddr, EventlogSocketOpts)))
-> IO (Maybe (EventlogSocketAddr, EventlogSocketOpts))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
24) ((Ptr EventlogSocketAddr
  -> IO (Maybe (EventlogSocketAddr, EventlogSocketOpts)))
 -> IO (Maybe (EventlogSocketAddr, EventlogSocketOpts)))
-> (Ptr EventlogSocketAddr
    -> IO (Maybe (EventlogSocketAddr, EventlogSocketOpts)))
-> IO (Maybe (EventlogSocketAddr, EventlogSocketOpts))
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketAddr
esaPtr ->
{-# LINE 219 "src/GHC/Eventlog/Socket.hsc" #-}
    allocaBytes (12) $ \esoPtr -> do
{-# LINE 220 "src/GHC/Eventlog/Socket.hsc" #-}
        let tryGet =
                allocaBytes (8) $ \essPtr -> do
{-# LINE 222 "src/GHC/Eventlog/Socket.hsc" #-}
                    eventlog_socket_from_env essPtr esaPtr esoPtr
                    peekEventlogSocketStatus essPtr
        let shouldFree status =
                elem (essStatusCode status) $
                    [ EVENTLOG_SOCKET_OK
                    , EVENTLOG_SOCKET_ERR_ENV_TOOLONG
                    , EVENTLOG_SOCKET_ERR_ENV_NOHOST
                    , EVENTLOG_SOCKET_ERR_ENV_NOPORT
                    ]
        let maybeFree status =
                when (shouldFree status) $ do
                    eventlog_socket_addr_free esaPtr
                    eventlog_socket_opts_free esoPtr
        let maybePeek status
                | essStatusCode status == EVENTLOG_SOCKET_OK = do
                    esa <- peekEventlogSocketAddr esaPtr
                    eso <- peekEventlogSocketOpts esoPtr
                    pure $ Just (esa, eso)
                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_NOADDR = do
                    pure Nothing
                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_TOOLONG = do
                    esa <- peekEventlogSocketAddr esaPtr
                    throwIO $ EventlogSocketAddrUnixPathTooLong (esaUnixPath esa)
                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_NOHOST = do
                    esa <- peekEventlogSocketAddr esaPtr
                    throwIO $ EventlogSocketAddrInetHostMissing (esaInetPort esa)
                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_NOPORT = do
                    esa <- peekEventlogSocketAddr esaPtr
                    throwIO $ EventlogSocketAddrInetHostMissing (esaInetHost esa)
                | otherwise =
                    vacuous $ withEventlogSocketStatus status throwEventlogSocketStatus

        bracket tryGet maybeFree maybePeek


--------------------------------------------------------------------------------
-- Environment variables

{- |
The name of the environment variable used by `eventlog_socket_from_env`
to determine the host name for a TCP/IPv4 socket.

@since 0.1.2.0
-}
eventlogSocketEnvInetHost :: String
-- NOTE: Keep in sync with EVENTLOG_SOCKET_ENV_INET_HOST in eventlog_socketh.h.
eventlogSocketEnvInetHost :: FilePath
eventlogSocketEnvInetHost = FilePath
"GHC_EVENTLOG_INET_HOST"


{- |
The name of the environment variable used by `eventlog_socket_from_env`
to determine the port number for a TCP/IPv4 socket.

@since 0.1.2.0
-}
eventlogSocketEnvInetPort :: String
-- NOTE: Keep in sync with EVENTLOG_SOCKET_ENV_INET_PORT in eventlog_socketh.h.
eventlogSocketEnvInetPort :: FilePath
eventlogSocketEnvInetPort = FilePath
"GHC_EVENTLOG_INET_PORT"

--------------------------------------------------------------------------------
-- Errors

{- |
The type of exceptions thrown by `fromEnv`.

@since 0.1.2.0
-}
data EventlogSocketAddrError
    = EventlogSocketAddrUnixPathTooLong FilePath
      -- ^ The found Unix domain socket path was too long.
    | EventlogSocketAddrInetHostMissing String
      -- ^ No TCP/IP port number was found, but no host name was found.
    | EventlogSocketAddrInetPortMissing String
      -- ^ A TCP/IP host name was found, but no port number was found.
    deriving (EventlogSocketAddrError -> EventlogSocketAddrError -> Bool
(EventlogSocketAddrError -> EventlogSocketAddrError -> Bool)
-> (EventlogSocketAddrError -> EventlogSocketAddrError -> Bool)
-> Eq EventlogSocketAddrError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventlogSocketAddrError -> EventlogSocketAddrError -> Bool
== :: EventlogSocketAddrError -> EventlogSocketAddrError -> Bool
$c/= :: EventlogSocketAddrError -> EventlogSocketAddrError -> Bool
/= :: EventlogSocketAddrError -> EventlogSocketAddrError -> Bool
Eq, Int -> EventlogSocketAddrError -> ShowS
[EventlogSocketAddrError] -> ShowS
EventlogSocketAddrError -> FilePath
(Int -> EventlogSocketAddrError -> ShowS)
-> (EventlogSocketAddrError -> FilePath)
-> ([EventlogSocketAddrError] -> ShowS)
-> Show EventlogSocketAddrError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventlogSocketAddrError -> ShowS
showsPrec :: Int -> EventlogSocketAddrError -> ShowS
$cshow :: EventlogSocketAddrError -> FilePath
show :: EventlogSocketAddrError -> FilePath
$cshowList :: [EventlogSocketAddrError] -> ShowS
showList :: [EventlogSocketAddrError] -> ShowS
Show)

instance Exception EventlogSocketAddrError where
    displayException :: EventlogSocketAddrError -> FilePath
displayException = \case
        EventlogSocketAddrUnixPathTooLong FilePath
esaUnixPath ->
            FilePath
"Unix domain socket paths are limited to 107 characters. "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"Found path with "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
esaUnixPath)
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" characters:\n"
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
esaUnixPath
        EventlogSocketAddrInetHostMissing FilePath
esaInetPort ->
            FilePath
"The port number "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
eventlogSocketEnvInetPort
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" was set to "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
esaInetPort
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", but the host name "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
eventlogSocketEnvInetHost
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" was not set."
        EventlogSocketAddrInetPortMissing FilePath
esaInetHost ->
            FilePath
"The host name  "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
eventlogSocketEnvInetHost
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" was set to "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
esaInetHost
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", but the port number "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
eventlogSocketEnvInetPort
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" was not set."

{- |
Test the current status of the worker thread. If it has failed, throw an `Control.Exception.IOException`.

@since 0.1.2.0
-}
testWorkerStatus :: IO ()
testWorkerStatus :: IO ()
testWorkerStatus =
    EventlogSocketStatus -> IO ()
throwEventlogSocketStatusAsIOException (EventlogSocketStatus -> IO ()) -> IO EventlogSocketStatus -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO EventlogSocketStatus
workerStatus

{- |
Test the current status of the control thread. If it has failed, throw an `Control.Exception.IOException`.

@since 0.1.2.0
-}
testControlStatus :: IO ()
testControlStatus :: IO ()
testControlStatus =
    EventlogSocketStatus -> IO ()
throwEventlogSocketStatusAsIOException (EventlogSocketStatus -> IO ()) -> IO EventlogSocketStatus -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO EventlogSocketStatus
controlStatus

{- |
Internal helper.

Read the current worker status.
-}
workerStatus :: IO EventlogSocketStatus
workerStatus :: IO EventlogSocketStatus
workerStatus =
    Int
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8) ((Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
 -> IO EventlogSocketStatus)
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketStatus
essPtr -> do
{-# LINE 349 "src/GHC/Eventlog/Socket.hsc" #-}
        Ptr EventlogSocketStatus -> IO ()
eventlog_socket_worker_status Ptr EventlogSocketStatus
essPtr
        Ptr EventlogSocketStatus -> IO EventlogSocketStatus
peekEventlogSocketStatus Ptr EventlogSocketStatus
essPtr

{- |
Internal helper.

Read the current control status.
-}
controlStatus :: IO EventlogSocketStatus
controlStatus :: IO EventlogSocketStatus
controlStatus =
    Int
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8) ((Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
 -> IO EventlogSocketStatus)
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketStatus
essPtr -> do
{-# LINE 360 "src/GHC/Eventlog/Socket.hsc" #-}
        Ptr EventlogSocketStatus -> IO ()
eventlog_socket_control_status Ptr EventlogSocketStatus
essPtr
        Ptr EventlogSocketStatus -> IO EventlogSocketStatus
peekEventlogSocketStatus Ptr EventlogSocketStatus
essPtr

{- |
Internal helper.

Throw an t`EventlogSocketStatus` as an `Control.Exception.IOException`.
-}
throwEventlogSocketStatusAsIOException :: EventlogSocketStatus -> IO ()
throwEventlogSocketStatusAsIOException :: EventlogSocketStatus -> IO ()
throwEventlogSocketStatusAsIOException EventlogSocketStatus
ess =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventlogSocketStatus -> EventlogSocketStatusCode
essStatusCode EventlogSocketStatus
ess EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool
forall a. Eq a => a -> a -> Bool
/= EventlogSocketStatusCode
EVENTLOG_SOCKET_OK) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO Void -> IO ()
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (IO Void -> IO ()) -> IO Void -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketStatus
-> (Ptr EventlogSocketStatus -> IO Void) -> IO Void
forall a.
EventlogSocketStatus -> (Ptr EventlogSocketStatus -> IO a) -> IO a
withEventlogSocketStatus EventlogSocketStatus
ess Ptr EventlogSocketStatus -> IO Void
throwEventlogSocketStatus

{- |
Internal helper.

Throw an t`EventlogSocketStatus` as an `Control.Exception.IOException`.

__Warning__: This function _still_ throws an error if the status code is `EVENTLOG_SOCKET_OK`.
-}
throwEventlogSocketStatus :: Ptr EventlogSocketStatus -> IO Void
throwEventlogSocketStatus :: Ptr EventlogSocketStatus -> IO Void
throwEventlogSocketStatus Ptr EventlogSocketStatus
essPtr = do
    strPtr <- Ptr EventlogSocketStatus -> IO CString
eventlog_socket_strerror Ptr EventlogSocketStatus
essPtr
    str <- peekNullableCString strPtr
    free strPtr
    throwIO $ userError str

--------------------------------------------------------------------------------
-- Hooks API
--------------------------------------------------------------------------------

{- |
The type of @eventlog-socket@ hooks.

@since 0.1.3.0
-}
newtype
    {-# CTYPE "eventlog_socket.h" "EventlogSocketHook" #-}
    Hook = Hook
        { Hook -> Word32
unHook :: Word32
{-# LINE 400 "src/GHC/Eventlog/Socket.hsc" #-}
        }
        deriving (Hook -> Hook -> Bool
(Hook -> Hook -> Bool) -> (Hook -> Hook -> Bool) -> Eq Hook
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hook -> Hook -> Bool
== :: Hook -> Hook -> Bool
$c/= :: Hook -> Hook -> Bool
/= :: Hook -> Hook -> Bool
Eq, Int -> Hook -> ShowS
[Hook] -> ShowS
Hook -> FilePath
(Int -> Hook -> ShowS)
-> (Hook -> FilePath) -> ([Hook] -> ShowS) -> Show Hook
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hook -> ShowS
showsPrec :: Int -> Hook -> ShowS
$cshow :: Hook -> FilePath
show :: Hook -> FilePath
$cshowList :: [Hook] -> ShowS
showList :: [Hook] -> ShowS
Show, Ptr Hook -> IO Hook
Ptr Hook -> Int -> IO Hook
Ptr Hook -> Int -> Hook -> IO ()
Ptr Hook -> Hook -> IO ()
Hook -> Int
(Hook -> Int)
-> (Hook -> Int)
-> (Ptr Hook -> Int -> IO Hook)
-> (Ptr Hook -> Int -> Hook -> IO ())
-> (forall b. Ptr b -> Int -> IO Hook)
-> (forall b. Ptr b -> Int -> Hook -> IO ())
-> (Ptr Hook -> IO Hook)
-> (Ptr Hook -> Hook -> IO ())
-> Storable Hook
forall b. Ptr b -> Int -> IO Hook
forall b. Ptr b -> Int -> Hook -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Hook -> Int
sizeOf :: Hook -> Int
$calignment :: Hook -> Int
alignment :: Hook -> Int
$cpeekElemOff :: Ptr Hook -> Int -> IO Hook
peekElemOff :: Ptr Hook -> Int -> IO Hook
$cpokeElemOff :: Ptr Hook -> Int -> Hook -> IO ()
pokeElemOff :: Ptr Hook -> Int -> Hook -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Hook
peekByteOff :: forall b. Ptr b -> Int -> IO Hook
$cpokeByteOff :: forall b. Ptr b -> Int -> Hook -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Hook -> IO ()
$cpeek :: Ptr Hook -> IO Hook
peek :: Ptr Hook -> IO Hook
$cpoke :: Ptr Hook -> Hook -> IO ()
poke :: Ptr Hook -> Hook -> IO ()
Storable)

{- |
The hook that runs /after/ @startEventLogging@ is called.

@since 0.1.3.0
-}
pattern HookPostStartEventLogging :: Hook
pattern $mHookPostStartEventLogging :: forall {r}. Hook -> ((# #) -> r) -> ((# #) -> r) -> r
$bHookPostStartEventLogging :: Hook
HookPostStartEventLogging = Hook 0
{-# LINE 410 "src/GHC/Eventlog/Socket.hsc" #-}

{- |
The hook that runs /before/ @endEventLogging@ is called.

@since 0.1.3.0
-}
pattern HookPreEndEventLogging :: Hook
pattern $mHookPreEndEventLogging :: forall {r}. Hook -> ((# #) -> r) -> ((# #) -> r) -> r
$bHookPreEndEventLogging :: Hook
HookPreEndEventLogging = Hook 1
{-# LINE 418 "src/GHC/Eventlog/Socket.hsc" #-}

{-# COMPLETE
    HookPostStartEventLogging,
    HookPreEndEventLogging #-}

{- |
The type of hook handlers.

The hook handler is evaluated once each time the control socket receives a request for the associated hook.

__Warning__: The hook handler /must not/ call back into the @eventlog-socket@ API.

@since 0.1.3.0
-}
type HookHandler = IO ()

{- |
Register an @eventlog-socket@ hook.

__Warning__: Hooks cannot be unregistered and will be kept in memory until program exit.

@since 0.1.3.0
-}
registerHook ::
    -- | The hook.
    Hook ->
    -- | The hook handler.
    HookHandler ->
    IO ()
registerHook :: Hook -> IO () -> IO ()
registerHook Hook
hook IO ()
hookHandler = do
    -- Wrap the Haskell hook handler for the C API
    let c_hookHandler :: Ptr a -> IO ()
c_hookHandler Ptr a
hookDataPtr =
            Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
hookDataPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            IO ()
hookHandler

    IO (FunPtr (Ptr (ZonkAny 6) -> IO ()))
-> (FunPtr (Ptr (ZonkAny 6) -> IO ()) -> IO ())
-> (FunPtr (Ptr (ZonkAny 6) -> IO ()) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError ((Ptr (ZonkAny 6) -> IO ())
-> IO (FunPtr (Ptr (ZonkAny 6) -> IO ()))
forall a. (Ptr a -> IO ()) -> IO (FunPtr (Ptr a -> IO ()))
makeHookHandlerFunPtr Ptr (ZonkAny 6) -> IO ()
forall a. Ptr a -> IO ()
c_hookHandler) FunPtr (Ptr (ZonkAny 6) -> IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (Ptr (ZonkAny 6) -> IO ()) -> IO ()) -> IO ())
-> (FunPtr (Ptr (ZonkAny 6) -> IO ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr (Ptr (ZonkAny 6) -> IO ())
c_hookHandlerPtr -> do

        -- Try to register the command:
        status <-
            -- Allocate space for the return status:
            Int
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8) ((Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
 -> IO EventlogSocketStatus)
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketStatus
essPtr -> do
{-# LINE 459 "src/GHC/Eventlog/Socket.hsc" #-}

                -- Try to register the command:
                Ptr EventlogSocketStatus
-> Hook
-> FunPtr (Ptr (ZonkAny 6) -> IO ())
-> Ptr (ZonkAny 6)
-> IO ()
forall a.
Ptr EventlogSocketStatus
-> Hook -> FunPtr (Ptr a -> IO ()) -> Ptr a -> IO ()
eventlog_socket_register_hook
                    Ptr EventlogSocketStatus
essPtr
                    Hook
hook
                    FunPtr (Ptr (ZonkAny 6) -> IO ())
c_hookHandlerPtr
                    Ptr (ZonkAny 6)
forall a. Ptr a
nullPtr

                -- Marshal the return status:
                Ptr EventlogSocketStatus -> IO EventlogSocketStatus
peekEventlogSocketStatus Ptr EventlogSocketStatus
essPtr

        -- Handle the return status:
        case essStatusCode status of
            -- The return status is OK.
            EventlogSocketStatusCode
EVENTLOG_SOCKET_OK -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

            -- The remaining errors are all system errors:
            EventlogSocketStatusCode
_otherwise ->
                IO Void -> IO ()
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (IO Void -> IO ()) -> IO Void -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketStatus
-> (Ptr EventlogSocketStatus -> IO Void) -> IO Void
forall a.
EventlogSocketStatus -> (Ptr EventlogSocketStatus -> IO a) -> IO a
withEventlogSocketStatus EventlogSocketStatus
status Ptr EventlogSocketStatus -> IO Void
throwEventlogSocketStatus

--------------------------------------------------------------------------------
-- Control Commands API
--------------------------------------------------------------------------------

{- |
The type of namespaces.

Namespaces are opaque and can only be obtained using `registerNamespace`.

@since 0.1.2.0
-}
newtype
    {-# CTYPE "eventlog_socket.h" "EventlogSocketControlNamespace" #-}
    Namespace = Namespace (Ptr Namespace)

{- |
Get the `String` name for the given t`Namespace`.

@since 0.1.2.0
-}
namespaceName :: Namespace -> IO String
namespaceName :: Namespace -> IO FilePath
namespaceName (Namespace Ptr Namespace
namespacePtr) = do
    CString -> IO FilePath
peekNullableCString (CString -> IO FilePath) -> IO CString -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Namespace -> IO CString
eventlog_socket_control_strnamespace Ptr Namespace
namespacePtr

{- |
The type of command IDs.

Command IDs must be non-zero integers between 1 and 255.

@since 0.1.2.0
-}
newtype
    {-# CTYPE "eventlog_socket.h" "EventlogSocketControlCommandId" #-}
    CommandId = CommandId Word8
{-# LINE 513 "src/GHC/Eventlog/Socket.hsc" #-}
    deriving (Eq, Show)

{- |
The type of command handlers.

The command handler is evaluated once each time the control socket receives a request for the associated command.

__Warning__: The command handler /must not/ call back into the @eventlog-socket@ API.

@since 0.1.2.0
-}
type CommandHandler = IO ()

{- |
Register an @eventlog-socket@ control namespace with the given name and returns an opaque t`Namespace` object.

To avoid conflicts, the namespace should use the name of the Haskell package that registers the commands.

If the size of the given name exceeds 255 bytes, this function throws v`EventlogSocketControlNamespaceTooLong`.

If a namespace is already registered under the given name, this function throws v`EventlogSocketControlNamespaceExists`.

If the binary was built without support for control commands, this function throws v`EventlogSocketControlUnsupported`.

__Warning__: Namespaces cannot be unregistered and will be kept in memory until program exit.

@since 0.1.2.0
-}
registerNamespace ::
    -- | The name for the namespace.
    String ->
    IO Namespace
registerNamespace :: FilePath -> IO Namespace
registerNamespace FilePath
namespace =
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca @(Ptr Namespace) ((Ptr (Ptr Namespace) -> IO Namespace) -> IO Namespace)
-> (Ptr (Ptr Namespace) -> IO Namespace) -> IO Namespace
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Namespace)
namespaceOut -> do
        -- Try to register the namespace:
        status <-
            -- Allocate space for the return status:
            Int
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8) ((Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
 -> IO EventlogSocketStatus)
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketStatus
essPtr ->
{-# LINE 551 "src/GHC/Eventlog/Socket.hsc" #-}
                FilePath
-> (CStringLen -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a. FilePath -> (CStringLen -> IO a) -> IO a
withCStringLen FilePath
namespace ((CStringLen -> IO EventlogSocketStatus)
 -> IO EventlogSocketStatus)
-> (CStringLen -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. (a -> b) -> a -> b
$ \(CString
namespacePtr, Int
namespaceLen) -> do

                    -- Check the namespace length:
                    let maxNamespaceLen :: Int
maxNamespaceLen = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
forall a. Bounded a => a
maxBound :: Word8)
{-# LINE 555 "src/GHC/Eventlog/Socket.hsc" #-}
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
namespaceLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxNamespaceLen) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                        EventlogSocketControlError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (EventlogSocketControlError -> IO ())
-> EventlogSocketControlError -> IO ()
forall a b. (a -> b) -> a -> b
$
                            FilePath -> Int -> Int -> EventlogSocketControlError
EventlogSocketControlNamespaceTooLong
                                FilePath
namespace
                                Int
namespaceLen
                                Int
maxNamespaceLen

                    -- Try to register the namespace:
                    Ptr EventlogSocketStatus
-> Word8 -> CString -> Ptr (Ptr Namespace) -> IO ()
eventlog_socket_control_register_namespace
                        Ptr EventlogSocketStatus
essPtr
                        (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
namespaceLen)
                        CString
namespacePtr
                        Ptr (Ptr Namespace)
namespaceOut

                    -- Marshal the return status:
                    Ptr EventlogSocketStatus -> IO EventlogSocketStatus
peekEventlogSocketStatus Ptr EventlogSocketStatus
essPtr

        -- Handle the return status:
        case essStatusCode status of
            -- The return status is OK, marshal and return the namespace.
            EventlogSocketStatusCode
EVENTLOG_SOCKET_OK -> Ptr Namespace -> Namespace
Namespace (Ptr Namespace -> Namespace) -> IO (Ptr Namespace) -> IO Namespace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr Namespace) -> IO (Ptr Namespace)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Namespace)
namespaceOut

            -- The binary was compiled without support for the control server.
            EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT -> EventlogSocketControlError -> IO Namespace
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO EventlogSocketControlError
EventlogSocketControlUnsupported

            -- The namespace was already registered.
            EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_CTL_EXISTS -> EventlogSocketControlError -> IO Namespace
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (EventlogSocketControlError -> IO Namespace)
-> EventlogSocketControlError -> IO Namespace
forall a b. (a -> b) -> a -> b
$ FilePath -> EventlogSocketControlError
EventlogSocketControlNamespaceExists FilePath
namespace

            -- The remaining errors are all system errors:
            EventlogSocketStatusCode
_otherwise ->
                IO Void -> IO Namespace
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (IO Void -> IO Namespace) -> IO Void -> IO Namespace
forall a b. (a -> b) -> a -> b
$ EventlogSocketStatus
-> (Ptr EventlogSocketStatus -> IO Void) -> IO Void
forall a.
EventlogSocketStatus -> (Ptr EventlogSocketStatus -> IO a) -> IO a
withEventlogSocketStatus EventlogSocketStatus
status Ptr EventlogSocketStatus -> IO Void
throwEventlogSocketStatus

{- |
Register an @eventlog-socket@ control command with the given ID and handler in the given namespace.

If a command is already registered under the given ID in the given namespace, this function throws v`EventlogSocketControlCommandExists`.

If the binary was built without support for control commands, this function throws v`EventlogSocketControlUnsupported`.

__Warning__: Commands cannot be unregistered and will be kept in memory until program exit.

@since 0.1.2.0
-}
registerCommand ::
    -- | The namespace.
    Namespace ->
    -- | The command ID.
    CommandId ->
    -- | The command handler.
    CommandHandler ->
    IO ()
registerCommand :: Namespace -> CommandId -> IO () -> IO ()
registerCommand (Namespace Ptr Namespace
namespacePtr) CommandId
commandId IO ()
commandHandler = do
    -- Wrap the Haskell command handler for the C API
    let c_commandHandler :: Ptr Namespace -> CommandId -> Ptr a -> IO ()
c_commandHandler Ptr Namespace
namespacePtr' CommandId
commandId' Ptr a
commandDataPtr =
            Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Ptr Namespace
namespacePtr Ptr Namespace -> Ptr Namespace -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Namespace
namespacePtr') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (CommandId
commandId CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
== CommandId
commandId') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            Bool -> IO () -> IO ()
forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
commandDataPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            IO ()
commandHandler

    -- Allocate a C function pointer for the command handler:
    --
    -- NOTE: This function pointer is only deallocated if registration fails.
    IO
  (FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ()))
-> (FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
    -> IO ())
-> (FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
    -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError ((Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
-> IO
     (FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ()))
forall a.
(Ptr Namespace -> CommandId -> Ptr a -> IO ())
-> IO (FunPtr (Ptr Namespace -> CommandId -> Ptr a -> IO ()))
makeCommandHandlerFunPtr Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ()
forall {a}. Ptr Namespace -> CommandId -> Ptr a -> IO ()
c_commandHandler) FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
-> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr ((FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
  -> IO ())
 -> IO ())
-> (FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
c_commandHandlerPtr -> do

        -- Try to register the command:
        status <-
            -- Allocate space for the return status:
            Int
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8) ((Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
 -> IO EventlogSocketStatus)
-> (Ptr EventlogSocketStatus -> IO EventlogSocketStatus)
-> IO EventlogSocketStatus
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketStatus
essPtr -> do
{-# LINE 623 "src/GHC/Eventlog/Socket.hsc" #-}

                -- Try to register the command:
                Ptr EventlogSocketStatus
-> Ptr Namespace
-> CommandId
-> FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
-> Ptr (ZonkAny 7)
-> IO ()
forall a.
Ptr EventlogSocketStatus
-> Ptr Namespace
-> CommandId
-> FunPtr (Ptr Namespace -> CommandId -> Ptr a -> IO ())
-> Ptr a
-> IO ()
eventlog_socket_control_register_command
                    Ptr EventlogSocketStatus
essPtr
                    Ptr Namespace
namespacePtr
                    CommandId
commandId
                    FunPtr (Ptr Namespace -> CommandId -> Ptr (ZonkAny 7) -> IO ())
c_commandHandlerPtr
                    Ptr (ZonkAny 7)
forall a. Ptr a
nullPtr

                -- Marshal the return status:
                Ptr EventlogSocketStatus -> IO EventlogSocketStatus
peekEventlogSocketStatus Ptr EventlogSocketStatus
essPtr

        -- Handle the return status:
        case essStatusCode status of
            -- The return status is OK.
            EventlogSocketStatusCode
EVENTLOG_SOCKET_OK -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

            -- The binary was compiled without support for the control server.
            EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT ->
                EventlogSocketControlError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO EventlogSocketControlError
EventlogSocketControlUnsupported

            -- The namespace was already registered.
            EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_CTL_EXISTS -> do
                namespace <- Namespace -> IO FilePath
namespaceName (Ptr Namespace -> Namespace
Namespace Ptr Namespace
namespacePtr)
                throwIO $ EventlogSocketControlCommandExists namespace commandId

            -- The remaining errors are all system errors:
            EventlogSocketStatusCode
_otherwise ->
                IO Void -> IO ()
forall (f :: * -> *) a. Functor f => f Void -> f a
vacuous (IO Void -> IO ()) -> IO Void -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketStatus
-> (Ptr EventlogSocketStatus -> IO Void) -> IO Void
forall a.
EventlogSocketStatus -> (Ptr EventlogSocketStatus -> IO a) -> IO a
withEventlogSocketStatus EventlogSocketStatus
status Ptr EventlogSocketStatus -> IO Void
throwEventlogSocketStatus

--------------------------------------------------------------------------------
-- Errors

{- |
The type of exceptions thrown by `registerNamespace` and `registerCommand`.

@since 0.1.2.0
-}
data EventlogSocketControlError
  = EventlogSocketControlNamespaceTooLong
        -- | The requested name for the namespace.
        String
        -- | The size of the requested name in bytes.
        Int
        -- | The maximum size in bytes.
        Int
  | EventlogSocketControlNamespaceExists
        -- | The requested name for the namespace.
        String
  | EventlogSocketControlCommandExists
        -- | The name for the namespace.
        String
        -- | The requested ID for the command.
        CommandId
  | EventlogSocketControlUnsupported
  deriving (EventlogSocketControlError -> EventlogSocketControlError -> Bool
(EventlogSocketControlError -> EventlogSocketControlError -> Bool)
-> (EventlogSocketControlError
    -> EventlogSocketControlError -> Bool)
-> Eq EventlogSocketControlError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventlogSocketControlError -> EventlogSocketControlError -> Bool
== :: EventlogSocketControlError -> EventlogSocketControlError -> Bool
$c/= :: EventlogSocketControlError -> EventlogSocketControlError -> Bool
/= :: EventlogSocketControlError -> EventlogSocketControlError -> Bool
Eq, Int -> EventlogSocketControlError -> ShowS
[EventlogSocketControlError] -> ShowS
EventlogSocketControlError -> FilePath
(Int -> EventlogSocketControlError -> ShowS)
-> (EventlogSocketControlError -> FilePath)
-> ([EventlogSocketControlError] -> ShowS)
-> Show EventlogSocketControlError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventlogSocketControlError -> ShowS
showsPrec :: Int -> EventlogSocketControlError -> ShowS
$cshow :: EventlogSocketControlError -> FilePath
show :: EventlogSocketControlError -> FilePath
$cshowList :: [EventlogSocketControlError] -> ShowS
showList :: [EventlogSocketControlError] -> ShowS
Show)

instance Exception EventlogSocketControlError where
    displayException :: EventlogSocketControlError -> FilePath
displayException = \case
        EventlogSocketControlNamespaceTooLong FilePath
namespace Int
namespaceLen Int
maxNamespaceLen ->
            FilePath
"The name '"
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
namespace
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"' was "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
namespaceLen
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" bytes. The maximum length is "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
maxNamespaceLen
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" bytes."
        EventlogSocketControlNamespaceExists FilePath
namespace ->
            FilePath
"The name '"
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
namespace
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"' is already registered."
        EventlogSocketControlCommandExists FilePath
namespace (CommandId Word8
commandId) ->
            FilePath
"The ID "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> FilePath
forall a. Show a => a -> FilePath
show Word8
commandId
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" is already registered for "
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
namespace
                FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"."
        EventlogSocketControlError
EventlogSocketControlUnsupported ->
            FilePath
"The binary was built without support for control commands."

--------------------------------------------------------------------------------
-- Legacy API
--------------------------------------------------------------------------------

{- |
Start an @eventlog-socket@ writer on the given Unix domain socket path and wait.

@since 0.1.0.0
-}
startWait :: FilePath -> IO ()
startWait :: FilePath -> IO ()
startWait FilePath
unixPath = do
    let addr :: EventlogSocketAddr
addr = FilePath -> EventlogSocketAddr
EventlogSocketUnixAddr FilePath
unixPath
    let opts :: EventlogSocketOpts
opts = EventlogSocketOpts
defaultEventlogSocketOpts{esoWait = True}
    EventlogSocketAddr -> EventlogSocketOpts -> IO ()
startWith EventlogSocketAddr
addr EventlogSocketOpts
opts

{- |
Start an @eventlog-socket@ writer on the given Unix domain socket path.

@since 0.1.0.0
-}
start :: FilePath -> IO ()
start :: FilePath -> IO ()
start FilePath
unixPath = do
    let addr :: EventlogSocketAddr
addr = FilePath -> EventlogSocketAddr
EventlogSocketUnixAddr FilePath
unixPath
    let opts :: EventlogSocketOpts
opts = EventlogSocketOpts
defaultEventlogSocketOpts{esoWait = False}
    EventlogSocketAddr -> EventlogSocketOpts -> IO ()
startWith EventlogSocketAddr
addr EventlogSocketOpts
opts

{- |
Wait for another process to connect to the eventlog socket.

@since 0.1.0.0
-}
wait :: IO ()
wait :: IO ()
wait = IO ()
eventlog_socket_wait

--------------------------------------------------------------------------------
-- Low-level API
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Low-level foreign types

{- |
The address family of the eventlog socket.

Used as the tag for the C tagged union @EventlogSocketAddr@.
-}
newtype
    {-# CTYPE "eventlog_socket.h" "EventlogSocketTag" #-}
    EventlogSocketTag = EventlogSocketTag
        { EventlogSocketTag -> Word32
unEventlogSocketTag :: Word32
{-# LINE 753 "src/GHC/Eventlog/Socket.hsc" #-}
        }
        deriving (EventlogSocketTag -> EventlogSocketTag -> Bool
(EventlogSocketTag -> EventlogSocketTag -> Bool)
-> (EventlogSocketTag -> EventlogSocketTag -> Bool)
-> Eq EventlogSocketTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventlogSocketTag -> EventlogSocketTag -> Bool
== :: EventlogSocketTag -> EventlogSocketTag -> Bool
$c/= :: EventlogSocketTag -> EventlogSocketTag -> Bool
/= :: EventlogSocketTag -> EventlogSocketTag -> Bool
Eq, Int -> EventlogSocketTag -> ShowS
[EventlogSocketTag] -> ShowS
EventlogSocketTag -> FilePath
(Int -> EventlogSocketTag -> ShowS)
-> (EventlogSocketTag -> FilePath)
-> ([EventlogSocketTag] -> ShowS)
-> Show EventlogSocketTag
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventlogSocketTag -> ShowS
showsPrec :: Int -> EventlogSocketTag -> ShowS
$cshow :: EventlogSocketTag -> FilePath
show :: EventlogSocketTag -> FilePath
$cshowList :: [EventlogSocketTag] -> ShowS
showList :: [EventlogSocketTag] -> ShowS
Show, Ptr EventlogSocketTag -> IO EventlogSocketTag
Ptr EventlogSocketTag -> Int -> IO EventlogSocketTag
Ptr EventlogSocketTag -> Int -> EventlogSocketTag -> IO ()
Ptr EventlogSocketTag -> EventlogSocketTag -> IO ()
EventlogSocketTag -> Int
(EventlogSocketTag -> Int)
-> (EventlogSocketTag -> Int)
-> (Ptr EventlogSocketTag -> Int -> IO EventlogSocketTag)
-> (Ptr EventlogSocketTag -> Int -> EventlogSocketTag -> IO ())
-> (forall b. Ptr b -> Int -> IO EventlogSocketTag)
-> (forall b. Ptr b -> Int -> EventlogSocketTag -> IO ())
-> (Ptr EventlogSocketTag -> IO EventlogSocketTag)
-> (Ptr EventlogSocketTag -> EventlogSocketTag -> IO ())
-> Storable EventlogSocketTag
forall b. Ptr b -> Int -> IO EventlogSocketTag
forall b. Ptr b -> Int -> EventlogSocketTag -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: EventlogSocketTag -> Int
sizeOf :: EventlogSocketTag -> Int
$calignment :: EventlogSocketTag -> Int
alignment :: EventlogSocketTag -> Int
$cpeekElemOff :: Ptr EventlogSocketTag -> Int -> IO EventlogSocketTag
peekElemOff :: Ptr EventlogSocketTag -> Int -> IO EventlogSocketTag
$cpokeElemOff :: Ptr EventlogSocketTag -> Int -> EventlogSocketTag -> IO ()
pokeElemOff :: Ptr EventlogSocketTag -> Int -> EventlogSocketTag -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO EventlogSocketTag
peekByteOff :: forall b. Ptr b -> Int -> IO EventlogSocketTag
$cpokeByteOff :: forall b. Ptr b -> Int -> EventlogSocketTag -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> EventlogSocketTag -> IO ()
$cpeek :: Ptr EventlogSocketTag -> IO EventlogSocketTag
peek :: Ptr EventlogSocketTag -> IO EventlogSocketTag
$cpoke :: Ptr EventlogSocketTag -> EventlogSocketTag -> IO ()
poke :: Ptr EventlogSocketTag -> EventlogSocketTag -> IO ()
Storable)

{- |
The tag for a Unix domain socket address.
-}
pattern EVENTLOG_SOCKET_UNIX :: EventlogSocketTag
pattern $mEVENTLOG_SOCKET_UNIX :: forall {r}. EventlogSocketTag -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_UNIX :: EventlogSocketTag
EVENTLOG_SOCKET_UNIX = EventlogSocketTag 0
{-# LINE 761 "src/GHC/Eventlog/Socket.hsc" #-}

{- |
The tag for a TCP/IP socket address.
-}
pattern EVENTLOG_SOCKET_INET :: EventlogSocketTag
pattern $mEVENTLOG_SOCKET_INET :: forall {r}. EventlogSocketTag -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_INET :: EventlogSocketTag
EVENTLOG_SOCKET_INET = EventlogSocketTag 1
{-# LINE 767 "src/GHC/Eventlog/Socket.hsc" #-}

{-# COMPLETE
    EVENTLOG_SOCKET_UNIX,
    EVENTLOG_SOCKET_INET #-}

{- |
The status codes used by the @eventlog-socket@ library.
-}
newtype
    {-# CTYPE "eventlog_socket.h" "EventlogSocketStatusCode" #-}
    EventlogSocketStatusCode = EventlogSocketStatusCode
        { EventlogSocketStatusCode -> Word32
unEventlogSocketStatusCode :: Word32
{-# LINE 779 "src/GHC/Eventlog/Socket.hsc" #-}
        }
        deriving (EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool
(EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool)
-> (EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool)
-> Eq EventlogSocketStatusCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool
== :: EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool
$c/= :: EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool
/= :: EventlogSocketStatusCode -> EventlogSocketStatusCode -> Bool
Eq, Int -> EventlogSocketStatusCode -> ShowS
[EventlogSocketStatusCode] -> ShowS
EventlogSocketStatusCode -> FilePath
(Int -> EventlogSocketStatusCode -> ShowS)
-> (EventlogSocketStatusCode -> FilePath)
-> ([EventlogSocketStatusCode] -> ShowS)
-> Show EventlogSocketStatusCode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventlogSocketStatusCode -> ShowS
showsPrec :: Int -> EventlogSocketStatusCode -> ShowS
$cshow :: EventlogSocketStatusCode -> FilePath
show :: EventlogSocketStatusCode -> FilePath
$cshowList :: [EventlogSocketStatusCode] -> ShowS
showList :: [EventlogSocketStatusCode] -> ShowS
Show, Ptr EventlogSocketStatusCode -> IO EventlogSocketStatusCode
Ptr EventlogSocketStatusCode -> Int -> IO EventlogSocketStatusCode
Ptr EventlogSocketStatusCode
-> Int -> EventlogSocketStatusCode -> IO ()
Ptr EventlogSocketStatusCode -> EventlogSocketStatusCode -> IO ()
EventlogSocketStatusCode -> Int
(EventlogSocketStatusCode -> Int)
-> (EventlogSocketStatusCode -> Int)
-> (Ptr EventlogSocketStatusCode
    -> Int -> IO EventlogSocketStatusCode)
-> (Ptr EventlogSocketStatusCode
    -> Int -> EventlogSocketStatusCode -> IO ())
-> (forall b. Ptr b -> Int -> IO EventlogSocketStatusCode)
-> (forall b. Ptr b -> Int -> EventlogSocketStatusCode -> IO ())
-> (Ptr EventlogSocketStatusCode -> IO EventlogSocketStatusCode)
-> (Ptr EventlogSocketStatusCode
    -> EventlogSocketStatusCode -> IO ())
-> Storable EventlogSocketStatusCode
forall b. Ptr b -> Int -> IO EventlogSocketStatusCode
forall b. Ptr b -> Int -> EventlogSocketStatusCode -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: EventlogSocketStatusCode -> Int
sizeOf :: EventlogSocketStatusCode -> Int
$calignment :: EventlogSocketStatusCode -> Int
alignment :: EventlogSocketStatusCode -> Int
$cpeekElemOff :: Ptr EventlogSocketStatusCode -> Int -> IO EventlogSocketStatusCode
peekElemOff :: Ptr EventlogSocketStatusCode -> Int -> IO EventlogSocketStatusCode
$cpokeElemOff :: Ptr EventlogSocketStatusCode
-> Int -> EventlogSocketStatusCode -> IO ()
pokeElemOff :: Ptr EventlogSocketStatusCode
-> Int -> EventlogSocketStatusCode -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO EventlogSocketStatusCode
peekByteOff :: forall b. Ptr b -> Int -> IO EventlogSocketStatusCode
$cpokeByteOff :: forall b. Ptr b -> Int -> EventlogSocketStatusCode -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> EventlogSocketStatusCode -> IO ()
$cpeek :: Ptr EventlogSocketStatusCode -> IO EventlogSocketStatusCode
peek :: Ptr EventlogSocketStatusCode -> IO EventlogSocketStatusCode
$cpoke :: Ptr EventlogSocketStatusCode -> EventlogSocketStatusCode -> IO ()
poke :: Ptr EventlogSocketStatusCode -> EventlogSocketStatusCode -> IO ()
Storable)

pattern EVENTLOG_SOCKET_OK :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_OK :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_OK :: EventlogSocketStatusCode
EVENTLOG_SOCKET_OK = EventlogSocketStatusCode 0
{-# LINE 784 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_RTS_NOSUPPORT :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_RTS_NOSUPPORT :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT = EventlogSocketStatusCode 1
{-# LINE 787 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_RTS_FAIL :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_RTS_FAIL :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_RTS_FAIL :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_RTS_FAIL = EventlogSocketStatusCode 2
{-# LINE 790 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_ENV_NOADDR :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_ENV_NOADDR :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_ENV_NOADDR :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_ENV_NOADDR = EventlogSocketStatusCode 3
{-# LINE 793 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_ENV_TOOLONG :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_ENV_TOOLONG :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_ENV_TOOLONG :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_ENV_TOOLONG = EventlogSocketStatusCode 4
{-# LINE 796 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_ENV_NOHOST :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_ENV_NOHOST :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_ENV_NOHOST :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_ENV_NOHOST = EventlogSocketStatusCode 5
{-# LINE 799 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_ENV_NOPORT :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_ENV_NOPORT :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_ENV_NOPORT :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_ENV_NOPORT = EventlogSocketStatusCode 6
{-# LINE 802 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_CTL_NOSUPPORT :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_CTL_NOSUPPORT :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT = EventlogSocketStatusCode 7
{-# LINE 805 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_CTL_EXISTS :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_CTL_EXISTS :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_CTL_EXISTS :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_CTL_EXISTS = EventlogSocketStatusCode 8
{-# LINE 808 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_GAI :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_GAI :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_GAI :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_GAI = EventlogSocketStatusCode 9
{-# LINE 811 "src/GHC/Eventlog/Socket.hsc" #-}

pattern EVENTLOG_SOCKET_ERR_SYS :: EventlogSocketStatusCode
pattern $mEVENTLOG_SOCKET_ERR_SYS :: forall {r}.
EventlogSocketStatusCode -> ((# #) -> r) -> ((# #) -> r) -> r
$bEVENTLOG_SOCKET_ERR_SYS :: EventlogSocketStatusCode
EVENTLOG_SOCKET_ERR_SYS = EventlogSocketStatusCode 10
{-# LINE 814 "src/GHC/Eventlog/Socket.hsc" #-}

{-# COMPLETE
    EVENTLOG_SOCKET_OK,
    EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT,
    EVENTLOG_SOCKET_ERR_RTS_FAIL,
    EVENTLOG_SOCKET_ERR_ENV_NOADDR,
    EVENTLOG_SOCKET_ERR_ENV_TOOLONG,
    EVENTLOG_SOCKET_ERR_ENV_NOHOST,
    EVENTLOG_SOCKET_ERR_ENV_NOPORT,
    EVENTLOG_SOCKET_ERR_CTL_EXISTS,
    EVENTLOG_SOCKET_ERR_GAI,
    EVENTLOG_SOCKET_ERR_SYS #-}

{- |
The status used by the @eventlog-socket@ library.
-}
data
    {-# CTYPE "eventlog_socket.h" "EventlogSocketStatus" #-}
    EventlogSocketStatus = EventlogSocketStatus
        { EventlogSocketStatus -> EventlogSocketStatusCode
essStatusCode :: !EventlogSocketStatusCode
        , EventlogSocketStatus -> Int32
essErrorCode :: !( Int32 )
{-# LINE 835 "src/GHC/Eventlog/Socket.hsc" #-}
        }
    deriving (EventlogSocketStatus -> EventlogSocketStatus -> Bool
(EventlogSocketStatus -> EventlogSocketStatus -> Bool)
-> (EventlogSocketStatus -> EventlogSocketStatus -> Bool)
-> Eq EventlogSocketStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventlogSocketStatus -> EventlogSocketStatus -> Bool
== :: EventlogSocketStatus -> EventlogSocketStatus -> Bool
$c/= :: EventlogSocketStatus -> EventlogSocketStatus -> Bool
/= :: EventlogSocketStatus -> EventlogSocketStatus -> Bool
Eq, Int -> EventlogSocketStatus -> ShowS
[EventlogSocketStatus] -> ShowS
EventlogSocketStatus -> FilePath
(Int -> EventlogSocketStatus -> ShowS)
-> (EventlogSocketStatus -> FilePath)
-> ([EventlogSocketStatus] -> ShowS)
-> Show EventlogSocketStatus
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EventlogSocketStatus -> ShowS
showsPrec :: Int -> EventlogSocketStatus -> ShowS
$cshow :: EventlogSocketStatus -> FilePath
show :: EventlogSocketStatus -> FilePath
$cshowList :: [EventlogSocketStatus] -> ShowS
showList :: [EventlogSocketStatus] -> ShowS
Show)

--------------------------------------------------------------------------------
-- Marshalling from foreign types

{- |
Marshal an `EventlogSocketAddr` from C.
-}
peekEventlogSocketAddr ::
    Ptr EventlogSocketAddr ->
    IO EventlogSocketAddr
peekEventlogSocketAddr :: Ptr EventlogSocketAddr -> IO EventlogSocketAddr
peekEventlogSocketAddr Ptr EventlogSocketAddr
esaPtr = do
    (\Ptr EventlogSocketAddr
hsc_ptr -> Ptr EventlogSocketAddr -> Int -> IO EventlogSocketTag
forall b. Ptr b -> Int -> IO EventlogSocketTag
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EventlogSocketAddr
hsc_ptr Int
0) Ptr EventlogSocketAddr
esaPtr IO EventlogSocketTag
-> (EventlogSocketTag -> IO EventlogSocketAddr)
-> IO EventlogSocketAddr
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
{-# LINE 849 "src/GHC/Eventlog/Socket.hsc" #-}
        EVENTLOG_SOCKET_UNIX -> do
            esaUnixPath <-
                peekNullableCString <=< peek
                    $ esaPtr
                    & (\hsc_ptr -> hsc_ptr `plusPtr` 8)
{-# LINE 854 "src/GHC/Eventlog/Socket.hsc" #-}
                    & (\hsc_ptr -> hsc_ptr `plusPtr` 0)
{-# LINE 855 "src/GHC/Eventlog/Socket.hsc" #-}
            pure EventlogSocketUnixAddr
                { esaUnixPath = esaUnixPath
                }
        EVENTLOG_SOCKET_INET -> do
            esaInetHost <-
                peekNullableCString <=< peek
                    $ esaPtr
                    & (\hsc_ptr -> hsc_ptr `plusPtr` 8)
{-# LINE 863 "src/GHC/Eventlog/Socket.hsc" #-}
                    & (\hsc_ptr -> hsc_ptr `plusPtr` 0)
{-# LINE 864 "src/GHC/Eventlog/Socket.hsc" #-}
            esaInetPort <-
                peekNullableCString <=< peek
                    $ esaPtr
                    & (\hsc_ptr -> hsc_ptr `plusPtr` 8)
{-# LINE 868 "src/GHC/Eventlog/Socket.hsc" #-}
                    & (\hsc_ptr -> hsc_ptr `plusPtr` 8)
{-# LINE 869 "src/GHC/Eventlog/Socket.hsc" #-}
            pure EventlogSocketInetAddr
                { esaInetHost = esaInetHost
                , esaInetPort = esaInetPort
                }

{- |
Marshal an `EventlogSocketAddr` to C.
-}
withEventlogSocketAddr ::
    EventlogSocketAddr ->
    (Ptr EventlogSocketAddr -> IO a) ->
    IO a
withEventlogSocketAddr :: forall a.
EventlogSocketAddr -> (Ptr EventlogSocketAddr -> IO a) -> IO a
withEventlogSocketAddr EventlogSocketAddr
esa Ptr EventlogSocketAddr -> IO a
action =
    case EventlogSocketAddr
esa of
        EventlogSocketUnixAddr{esaUnixPath :: EventlogSocketAddr -> FilePath
esaUnixPath = FilePath
esaUnixPath} ->
            Int -> (Ptr EventlogSocketAddr -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
24) ((Ptr EventlogSocketAddr -> IO a) -> IO a)
-> (Ptr EventlogSocketAddr -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketAddr
esaPtr -> do
{-# LINE 885 "src/GHC/Eventlog/Socket.hsc" #-}
                (\Ptr EventlogSocketAddr
hsc_ptr -> Ptr EventlogSocketAddr -> Int -> EventlogSocketTag -> IO ()
forall b. Ptr b -> Int -> EventlogSocketTag -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr EventlogSocketAddr
hsc_ptr Int
0) Ptr EventlogSocketAddr
esaPtr EventlogSocketTag
EVENTLOG_SOCKET_UNIX
{-# LINE 886 "src/GHC/Eventlog/Socket.hsc" #-}
                FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
esaUnixPath ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
esaUnixPathCString -> do
                    (Ptr CString -> CString -> IO ())
-> CString -> Ptr CString -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke CString
esaUnixPathCString
                        (Ptr CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr EventlogSocketAddr
esaPtr
                        Ptr EventlogSocketAddr
-> (Ptr EventlogSocketAddr -> Ptr (ZonkAny 3)) -> Ptr (ZonkAny 3)
forall a b. a -> (a -> b) -> b
& (\Ptr EventlogSocketAddr
hsc_ptr -> Ptr EventlogSocketAddr
hsc_ptr Ptr EventlogSocketAddr -> Int -> Ptr (ZonkAny 3)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
{-# LINE 890 "src/GHC/Eventlog/Socket.hsc" #-}
                        Ptr (ZonkAny 3) -> (Ptr (ZonkAny 3) -> Ptr CString) -> Ptr CString
forall a b. a -> (a -> b) -> b
& (\Ptr (ZonkAny 3)
hsc_ptr -> Ptr (ZonkAny 3)
hsc_ptr Ptr (ZonkAny 3) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0)
{-# LINE 891 "src/GHC/Eventlog/Socket.hsc" #-}
                    Ptr EventlogSocketAddr -> IO a
action Ptr EventlogSocketAddr
esaPtr
        EventlogSocketInetAddr{esaInetHost :: EventlogSocketAddr -> FilePath
esaInetHost = FilePath
esaInetHost, esaInetPort :: EventlogSocketAddr -> FilePath
esaInetPort = FilePath
esaInetPort} ->
            Int -> (Ptr EventlogSocketAddr -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
24) ((Ptr EventlogSocketAddr -> IO a) -> IO a)
-> (Ptr EventlogSocketAddr -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketAddr
esaPtr -> do
{-# LINE 894 "src/GHC/Eventlog/Socket.hsc" #-}
                (\Ptr EventlogSocketAddr
hsc_ptr -> Ptr EventlogSocketAddr -> Int -> EventlogSocketTag -> IO ()
forall b. Ptr b -> Int -> EventlogSocketTag -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr EventlogSocketAddr
hsc_ptr Int
0) Ptr EventlogSocketAddr
esaPtr EventlogSocketTag
EVENTLOG_SOCKET_INET
{-# LINE 895 "src/GHC/Eventlog/Socket.hsc" #-}
                FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
esaInetHost ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
esaInetHostCString -> do
                    (Ptr CString -> CString -> IO ())
-> CString -> Ptr CString -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke CString
esaInetHostCString
                        (Ptr CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr EventlogSocketAddr
esaPtr
                        Ptr EventlogSocketAddr
-> (Ptr EventlogSocketAddr -> Ptr (ZonkAny 4)) -> Ptr (ZonkAny 4)
forall a b. a -> (a -> b) -> b
& (\Ptr EventlogSocketAddr
hsc_ptr -> Ptr EventlogSocketAddr
hsc_ptr Ptr EventlogSocketAddr -> Int -> Ptr (ZonkAny 4)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
{-# LINE 899 "src/GHC/Eventlog/Socket.hsc" #-}
                        Ptr (ZonkAny 4) -> (Ptr (ZonkAny 4) -> Ptr CString) -> Ptr CString
forall a b. a -> (a -> b) -> b
& (\Ptr (ZonkAny 4)
hsc_ptr -> Ptr (ZonkAny 4)
hsc_ptr Ptr (ZonkAny 4) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0)
{-# LINE 900 "src/GHC/Eventlog/Socket.hsc" #-}
                    FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
esaInetPort ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
esaInetPortCString -> do
                        (Ptr CString -> CString -> IO ())
-> CString -> Ptr CString -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke CString
esaInetPortCString
                            (Ptr CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr EventlogSocketAddr
esaPtr
                            Ptr EventlogSocketAddr
-> (Ptr EventlogSocketAddr -> Ptr (ZonkAny 5)) -> Ptr (ZonkAny 5)
forall a b. a -> (a -> b) -> b
& (\Ptr EventlogSocketAddr
hsc_ptr -> Ptr EventlogSocketAddr
hsc_ptr Ptr EventlogSocketAddr -> Int -> Ptr (ZonkAny 5)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
{-# LINE 904 "src/GHC/Eventlog/Socket.hsc" #-}
                            Ptr (ZonkAny 5) -> (Ptr (ZonkAny 5) -> Ptr CString) -> Ptr CString
forall a b. a -> (a -> b) -> b
& (\Ptr (ZonkAny 5)
hsc_ptr -> Ptr (ZonkAny 5)
hsc_ptr Ptr (ZonkAny 5) -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8)
{-# LINE 905 "src/GHC/Eventlog/Socket.hsc" #-}
                        Ptr EventlogSocketAddr -> IO a
action Ptr EventlogSocketAddr
esaPtr

{- |
Marshal an t`EventlogSocketOpts` from C.
-}
peekEventlogSocketOpts ::
    Ptr EventlogSocketOpts ->
    IO EventlogSocketOpts
peekEventlogSocketOpts :: Ptr EventlogSocketOpts -> IO EventlogSocketOpts
peekEventlogSocketOpts Ptr EventlogSocketOpts
esoPtr = do
    esoWait <- CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> (Word8 -> CBool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CBool
CBool (Word8 -> Bool) -> IO Word8 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\Ptr EventlogSocketOpts
hsc_ptr -> Ptr EventlogSocketOpts -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EventlogSocketOpts
hsc_ptr Int
0) Ptr EventlogSocketOpts
esoPtr
{-# LINE 915 "src/GHC/Eventlog/Socket.hsc" #-}
    esoSndbuf <- (\hsc_ptr -> peekByteOff hsc_ptr 4) esoPtr
{-# LINE 916 "src/GHC/Eventlog/Socket.hsc" #-}
    esoLinger <- (\hsc_ptr -> peekByteOff hsc_ptr 8) esoPtr
{-# LINE 917 "src/GHC/Eventlog/Socket.hsc" #-}
    pure EventlogSocketOpts
        { esoWait = esoWait
        , esoSndbuf =
            if esoSndbuf <= 0 then Nothing else Just esoSndbuf
        , esoLinger =
            if esoLinger <= 0 then Nothing else Just esoLinger
        }

{- |
Marshal an t`EventlogSocketOpts` to C.
-}
withEventlogSocketOpts ::
    EventlogSocketOpts ->
    (Ptr EventlogSocketOpts -> IO a) ->
    IO a
withEventlogSocketOpts :: forall a.
EventlogSocketOpts -> (Ptr EventlogSocketOpts -> IO a) -> IO a
withEventlogSocketOpts EventlogSocketOpts
eso Ptr EventlogSocketOpts -> IO a
action =
    Int -> (Ptr EventlogSocketOpts -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
12) ((Ptr EventlogSocketOpts -> IO a) -> IO a)
-> (Ptr EventlogSocketOpts -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketOpts
esoPtr -> do
{-# LINE 934 "src/GHC/Eventlog/Socket.hsc" #-}
        (\Ptr EventlogSocketOpts
hsc_ptr -> Ptr EventlogSocketOpts -> Int -> CBool -> IO ()
forall b. Ptr b -> Int -> CBool -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr EventlogSocketOpts
hsc_ptr Int
0) Ptr EventlogSocketOpts
esoPtr (CBool -> IO ()) -> (Bool -> CBool) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> CBool
CBool (Word8 -> CBool) -> (Bool -> Word8) -> Bool -> CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Word8
forall a. Num a => Bool -> a
fromBool (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketOpts -> Bool
esoWait EventlogSocketOpts
eso
{-# LINE 935 "src/GHC/Eventlog/Socket.hsc" #-}
        (\Ptr EventlogSocketOpts
hsc_ptr -> Ptr EventlogSocketOpts -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr EventlogSocketOpts
hsc_ptr Int
4) Ptr EventlogSocketOpts
esoPtr (Int32 -> IO ()) -> (Maybe Int32 -> Int32) -> Maybe Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 (Maybe Int32 -> IO ()) -> Maybe Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketOpts -> Maybe Int32
esoSndbuf EventlogSocketOpts
eso
{-# LINE 936 "src/GHC/Eventlog/Socket.hsc" #-}
        (\Ptr EventlogSocketOpts
hsc_ptr -> Ptr EventlogSocketOpts -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr EventlogSocketOpts
hsc_ptr Int
8) Ptr EventlogSocketOpts
esoPtr (Int32 -> IO ()) -> (Maybe Int32 -> Int32) -> Maybe Int32 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 (Maybe Int32 -> IO ()) -> Maybe Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketOpts -> Maybe Int32
esoLinger EventlogSocketOpts
eso
{-# LINE 937 "src/GHC/Eventlog/Socket.hsc" #-}
        Ptr EventlogSocketOpts -> IO a
action Ptr EventlogSocketOpts
esoPtr

{- |
Marshal an t`EventlogSocketStatus` from C.
-}
peekEventlogSocketStatus ::
    Ptr EventlogSocketStatus ->
    IO EventlogSocketStatus
peekEventlogSocketStatus :: Ptr EventlogSocketStatus -> IO EventlogSocketStatus
peekEventlogSocketStatus Ptr EventlogSocketStatus
essPtr = do
    essStatusCode <-
        (\Ptr EventlogSocketStatus
hsc_ptr -> Ptr EventlogSocketStatus -> Int -> IO EventlogSocketStatusCode
forall b. Ptr b -> Int -> IO EventlogSocketStatusCode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr EventlogSocketStatus
hsc_ptr Int
0) Ptr EventlogSocketStatus
essPtr
{-# LINE 948 "src/GHC/Eventlog/Socket.hsc" #-}
    essErrorCode <-
        if essStatusCode `elem` [EVENTLOG_SOCKET_ERR_GAI, EVENTLOG_SOCKET_ERR_SYS]
            then (\hsc_ptr -> peekByteOff hsc_ptr 4) essPtr
{-# LINE 951 "src/GHC/Eventlog/Socket.hsc" #-}
            else pure 0
    pure EventlogSocketStatus
        { essStatusCode = essStatusCode
        , essErrorCode = essErrorCode
        }

{- |
Marshal an t`EventlogSocketStatus` to C.
-}
withEventlogSocketStatus ::
    EventlogSocketStatus ->
    (Ptr EventlogSocketStatus -> IO a) ->
    IO a
withEventlogSocketStatus :: forall a.
EventlogSocketStatus -> (Ptr EventlogSocketStatus -> IO a) -> IO a
withEventlogSocketStatus EventlogSocketStatus
ess Ptr EventlogSocketStatus -> IO a
action =
    Int -> (Ptr EventlogSocketStatus -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8) ((Ptr EventlogSocketStatus -> IO a) -> IO a)
-> (Ptr EventlogSocketStatus -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr EventlogSocketStatus
essPtr -> do
{-# LINE 966 "src/GHC/Eventlog/Socket.hsc" #-}
        (\Ptr EventlogSocketStatus
hsc_ptr -> Ptr EventlogSocketStatus
-> Int -> EventlogSocketStatusCode -> IO ()
forall b. Ptr b -> Int -> EventlogSocketStatusCode -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr EventlogSocketStatus
hsc_ptr Int
0) Ptr EventlogSocketStatus
essPtr (EventlogSocketStatusCode -> IO ())
-> EventlogSocketStatusCode -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketStatus -> EventlogSocketStatusCode
essStatusCode EventlogSocketStatus
ess
{-# LINE 967 "src/GHC/Eventlog/Socket.hsc" #-}
        (\Ptr EventlogSocketStatus
hsc_ptr -> Ptr EventlogSocketStatus -> Int -> Int32 -> IO ()
forall b. Ptr b -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr EventlogSocketStatus
hsc_ptr Int
4) Ptr EventlogSocketStatus
essPtr (Int32 -> IO ()) -> Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ EventlogSocketStatus -> Int32
essErrorCode EventlogSocketStatus
ess
{-# LINE 968 "src/GHC/Eventlog/Socket.hsc" #-}
        Ptr EventlogSocketStatus -> IO a
action Ptr EventlogSocketStatus
essPtr

{- |
Variant of `peekCString` that checks for `nullPtr`.
-}
peekNullableCString :: CString -> IO String
peekNullableCString :: CString -> IO FilePath
peekNullableCString CString
charPtr
    | CString
charPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr = FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
""
    | Bool
otherwise = CString -> IO FilePath
peekCString CString
charPtr

--------------------------------------------------------------------------------
-- Foreign imports
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- eventlog_socket_addr_free

foreign import capi safe "eventlog_socket.h eventlog_socket_addr_free"
    eventlog_socket_addr_free ::
        Ptr EventlogSocketAddr ->
        IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_opts_init

foreign import capi safe "eventlog_socket.h eventlog_socket_opts_init"
    eventlog_socket_opts_init ::
        Ptr EventlogSocketOpts ->
        IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_opts_free

foreign import capi safe "eventlog_socket.h eventlog_socket_opts_free"
    eventlog_socket_opts_free ::
        Ptr EventlogSocketOpts ->
        IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_start

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_start"
    eventlog_socket_start ::
        Ptr EventlogSocketStatus ->
        Ptr EventlogSocketAddr ->
        Ptr EventlogSocketOpts ->
        IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_from_env

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_from_env"
    eventlog_socket_from_env ::
        Ptr EventlogSocketStatus ->
        Ptr EventlogSocketAddr ->
        Ptr EventlogSocketOpts ->
        IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_wait

foreign import capi safe "eventlog_socket.h eventlog_socket_wait"
    eventlog_socket_wait :: IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_strerror

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_strerror"
    eventlog_socket_strerror ::
        Ptr EventlogSocketStatus ->
        IO CString

--------------------------------------------------------------------------------
-- eventlog_socket_register_hook

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_register_hook"
    eventlog_socket_register_hook ::
        Ptr EventlogSocketStatus ->
        Hook ->
        FunPtr (Ptr a -> IO ()) ->
        Ptr a ->
        IO ()

foreign import ccall "wrapper"
    makeHookHandlerFunPtr ::
        (Ptr a -> IO ()) ->
        IO (FunPtr (Ptr a -> IO ()))

--------------------------------------------------------------------------------
-- eventlog_socket_worker_status

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_worker_status"
    eventlog_socket_worker_status ::
        Ptr EventlogSocketStatus ->
        IO ()
--------------------------------------------------------------------------------
-- eventlog_socket_control_status

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_control_status"
    eventlog_socket_control_status ::
        Ptr EventlogSocketStatus ->
        IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_control_strnamespace

-- NOTE: This uses `ccall` rather than `capi` because the underlying function
--       returns a `const char*` and `ConstPtr` wasn't added until GHC 9.6.1.

foreign import ccall safe "eventlog_socket.h eventlog_socket_control_strnamespace"
    eventlog_socket_control_strnamespace ::
        Ptr Namespace ->
        IO CString

--------------------------------------------------------------------------------
-- eventlog_socket_control_register_namespace

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_control_register_namespace"
    eventlog_socket_control_register_namespace ::
        Ptr EventlogSocketStatus ->
        ( Word8 ) ->
{-# LINE 1089 "src/GHC/Eventlog/Socket.hsc" #-}
        CString ->
        Ptr (Ptr Namespace) ->
        IO ()

--------------------------------------------------------------------------------
-- eventlog_socket_control_register_command

foreign import capi safe "eventlog_socket/hsapi.h es_hsapi_control_register_command"
    eventlog_socket_control_register_command ::
        Ptr EventlogSocketStatus ->
        Ptr Namespace ->
        CommandId ->
        FunPtr (Ptr Namespace -> CommandId -> Ptr a -> IO ()) ->
        Ptr a ->
        IO ()

foreign import ccall "wrapper"
    makeCommandHandlerFunPtr ::
        (Ptr Namespace -> CommandId -> Ptr a -> IO ()) ->
        IO (FunPtr (Ptr Namespace -> CommandId -> Ptr a -> IO ()))