-- | This helps to setup logging to /standard ouput/.
module Control.Eff.LogWriter.UnixSocket
( withUnixSocketLogWriter
, withUnixSocketLogging
)
where
import Control.Eff as Eff
import Control.Eff.Log
import Control.Eff.LogWriter.IO
import Control.Eff.LogWriter.Console
import Data.Text as T
import Data.Text.IO as T
import Data.Text.Encoding as T
import qualified Control.Exception.Safe as Safe
import Control.Monad ( void )
import qualified Control.Monad.Catch as Catch
import Control.Monad.Trans.Control ( MonadBaseControl
, liftBaseOp
)
import GHC.Stack
import qualified System.Socket as Socket
import System.Socket.Type.Datagram as Socket
import System.Socket.Family.Unix as Socket
import qualified System.Socket.Protocol.Default
as Socket
-- | Enable logging to a /unix domain socket/, with some 'LogMessage' fields preset
-- as in 'withIoLogging'.
--
-- See 'Control.Eff.Log.Examples.exampleDevLogSyslogLogging'
withUnixSocketLogging
:: (HasCallStack, MonadBaseControl IO (Eff e), Lifted IO e)
=> LogMessageRenderer Text -- ^ 'LogMessage' rendering function
-> FilePath -- ^ Path to the socket file
-> Text -- ^ The default application name to put into the 'lmAppName' field.
-> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.
-> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"
-> Eff (Logs : LogWriterReader IO : e) a
-> Eff e a
withUnixSocketLogging render socketPath a f p e = liftBaseOp
(withUnixSocketSocket render socketPath)
(\lw -> withIoLogging lw a f p e)
-- | Enable logging to a (remote-) host via UnixSocket.
--
-- See 'Control.Eff.Log.Examples.exampleDevLogSyslogLogging'
withUnixSocketLogWriter
:: (Lifted IO e, LogsTo IO e, MonadBaseControl IO (Eff e), HasCallStack)
=> LogMessageRenderer Text -- ^ 'LogMessage' rendering function
-> FilePath -- ^ Path to the socket file
-> Eff e b
-> Eff e b
withUnixSocketLogWriter render socketPath e =
liftBaseOp (withUnixSocketSocket render socketPath) (`addLogWriter` e)
withUnixSocketSocket
:: HasCallStack
=> LogMessageRenderer Text -- ^ 'LogMessage' rendering function
-> FilePath -- ^ Path to the socket file
-> (LogWriter IO -> IO a)
-> IO a
withUnixSocketSocket render socketPath ioE = Safe.bracket
(Socket.socket :: IO (Socket.Socket Unix Datagram Socket.Default))
(Safe.try @IO @Catch.SomeException . Socket.close)
(\s -> case socketAddressUnixPath (T.encodeUtf8 (T.pack socketPath)) of
Just addr -> do
Socket.connect s addr
ioE
(mkLogWriterIO
(\lmStr -> void
$ Socket.send s (T.encodeUtf8 (render lmStr)) Socket.msgNoSignal
)
)
Nothing -> do
T.putStrLn $ "could not open unix domain socket: " <> T.pack socketPath
ioE consoleLogWriter
)