module Control.Eff.LogWriter.UDP
( withUDPLogWriter
, withUDPLogging
)
where
import Control.Eff as Eff
import Control.Eff.Log
import Control.Eff.LogWriter.IO
import Data.Text 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 Network.Socket hiding ( sendTo )
import Network.Socket.ByteString
withUDPLogging
:: (HasCallStack, MonadBaseControl IO (Eff e), Lifted IO e)
=> (LogMessage -> Text)
-> String
-> String
-> Text
-> Facility
-> LogPredicate
-> Eff (Logs : LogWriterReader (Lift IO) : e) a
-> Eff e a
withUDPLogging render hostname port a f p e = liftBaseOp
(withUDPSocket render hostname port)
(\lw -> withIoLogging lw a f p e)
withUDPLogWriter
:: (LogIo e, MonadBaseControl IO (Eff e), HasCallStack)
=> (LogMessage -> Text)
-> String
-> String
-> Eff e b
-> Eff e b
withUDPLogWriter render hostname port e =
liftBaseOp (withUDPSocket render hostname port) (`addLogWriter` e)
withUDPSocket
:: HasCallStack
=> (LogMessage -> Text)
-> String
-> String
-> (LogWriter (Lift IO) -> IO a)
-> IO a
withUDPSocket render hostname port ioE = Safe.bracket
(do
let hints = defaultHints { addrSocketType = Datagram }
addr : _ <- getAddrInfo (Just hints) (Just hostname) (Just port)
s <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
return (addr, s)
)
(Safe.try @IO @Catch.SomeException . close . snd)
(\(a, s) ->
let addr = addrAddress a
in
ioE
(mkLogWriterIO
(\lmStr ->
void $ sendTo s (T.encodeUtf8 (render lmStr)) addr
)
)
)