{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Katip.Scribes.Scalyr where
-------------------------------------------------------------------------------
import Control.Applicative as A
import Control.Concurrent
import Control.Exception (bracket_, finally)
import Control.Monad
import Data.Aeson
import Data.Aeson.Text
import qualified Data.HashMap.Strict as HM
import Data.Maybe (maybeToList)
import Data.Monoid
import Data.Scientific as S
import Data.Text (Text, pack)
import Data.Text.Internal.Builder
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.IO as T
import System.IO
-------------------------------------------------------------------------------
import Katip.Core
import Katip.Format.Time (formatAsLogTime)
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- | Logs to a file handle such as stdout, stderr, or a file. Contexts
-- and other information will be flattened out into bracketed
-- fields. The flattening converts field names to uppercase, e.g.
--
-- > {"foo": {"bar": 42}}
--
-- is parsed as
--
-- > fooBar = 42
--
-- Naturally, collisions between flattened fields and actual values may
-- happen. There is currently no mitigation, and I'm not sure what Scalyr
-- does in that case. Keep your json snake_case only and you should be
-- golden.
--
-- Returns the newly-created `Scribe`. The finalizer flushes the
-- handle. Handle mode is set to 'LineBuffering' automatically.
mkScalyrScribe :: Handle -> Severity -> Verbosity -> IO Scribe
mkScalyrScribe h sev verb = do
hSetBuffering h LineBuffering
lock <- newMVar ()
let logger i@Item{..} =
when (permitItem sev i) $ bracket_ (takeMVar lock) (putMVar lock ()) $
T.hPutStrLn h $ encodeToLazyText $ Object $ formatItem verb i
pure $ Scribe logger (hFlush h)
-------------------------------------------------------------------------------
formatItem :: LogItem a => Verbosity -> Item a -> HM.HashMap Text Value
formatItem verb item@Item{..} =
HM.fromList $ [
("timestamp", String $ formatAsLogTime _itemTime)
, ("namespace", String $ mconcat $ intercalateNs _itemNamespace)
, ("applicationName", String $ mconcat $ unNamespace _itemApp)
, ("environment", String $ getEnvironment _itemEnv)
, ("severity", String $ renderSeverity _itemSeverity)
, ("hostname", String $ pack _itemHost)
, ("processId", String $ pack $ show _itemProcess)
, ("threadId", String $ getThreadIdText _itemThread)
, ("payload", itemJson verb item)
, ("message", String $ LT.toStrict $ toLazyText $ unLogStr _itemMessage)
] <>
maybeToList (fmap (("sourceLocation",) . String . pack . locationToString) _itemLoc)
-------------------------------------------------------------------------------
-- | Creates a scribe for scalyr. Pass the application name, and the environment,
-- e.g. staging or production.
scalyrLogEnv :: Text -> Environment -> Severity -> Verbosity -> IO LogEnv
scalyrLogEnv appName env sev verb = do
le <- initLogEnv (Namespace [appName]) env
lh <- mkScalyrScribe stdout sev verb
registerScribe "scalyr" lh defaultScribeSettings le