{- | Entrypoint module for the package -} module Network.Wai.Middleware.RequestLogger.LogEntries ( Config (..) , logEntriesLogger -- UUID export to make configuration a bit easier , UUID , UUID.fromString , UUID.nil ) where import Network.Wai import Network.Wai.Middleware.RequestLogger ( RequestLoggerSettings (..) , OutputFormat (..) , Destination (..) , IPAddrSource (..) , mkRequestLogger) import Network.Wai.Middleware.RequestLogger.Internal.Formatting (buildLogMessage) import qualified Data.ByteString.Char8 as BS8 import Data.Default (def) import Data.Monoid ((<>)) import Data.UUID.Types (UUID) import qualified Data.UUID.Types as UUID import Network.Socket import System.IO.Unsafe (unsafePerformIO) import System.Log.FastLogger (LogStr, fromLogStr, toLogStr) import Control.Concurrent (forkIO) import Control.Exception (bracket) import qualified Control.Concurrent.STM as STM {- | Account configuration -} data Config = Config { hostname :: String , port :: Int , token :: UUID } deriving (Show) {- | Function to create the LogEntries Middleware -} logEntriesLogger :: Config -> Middleware logEntriesLogger config = unsafePerformIO $ do logChan <- STM.newTChanIO forkIO (logRequests config logChan) >> mkRequestLogger (logEntriesSettings logChan) logEntriesSettings :: STM.TChan LogStr -> RequestLoggerSettings logEntriesSettings logChan = def { outputFormat = Apache FromSocket , destination = Callback (addLogMessage logChan) } addLogMessage :: STM.TChan LogStr -> LogStr -> IO () addLogMessage logChan logStr = do STM.atomically $ STM.writeTChan logChan logStr return () sendLogMessage :: Config -> STM.TChan LogStr -> Socket -> IO () sendLogMessage config@Config{..} logChan sock = do logStr <- STM.atomically $ STM.readTChan logChan _ <- send sock $ buildLogMessage token logStr sendLogMessage config logChan sock -- recur forever logRequests :: Config -> STM.TChan LogStr -> IO () logRequests config@Config{..} logChan = do addrs <- getAddrInfo Nothing (Just hostname) (Just . show $ port) case addrs of [] -> return () (serverAddr:_) -> bracket (openSocket serverAddr) sClose (sendLogMessage config logChan) openSocket :: AddrInfo -> IO Socket openSocket AddrInfo{..} = do sock <- socket addrFamily Stream defaultProtocol connect sock addrAddress return sock