-- | Working with Bugsnag's 'event_metaData' field
module Freckle.App.Bugsnag.MetaData
  ( MetaData (..)
  , metaData
  , metaDataL

    -- * Collecting ambient data
  , collectMetaData
  , collectMetaDataFromStatsClient
  , collectMetaDataFromThreadContext

    -- * 'BeforeNotify'
  , mergeMetaData
  ) where

import Freckle.App.Prelude

import Blammo.Logging (myThreadContext)
import Control.Lens (Lens', lens, to, view, (<>~))
import Data.Aeson (Value (..))
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Bugsnag (Event (..))
import Data.String (fromString)
import Freckle.App.Stats (HasStatsClient (..), tagsL)
import Network.Bugsnag (BeforeNotify, updateEvent)
import Network.Bugsnag.MetaData

metaDataL :: Lens' Event MetaData
metaDataL :: Lens' Event MetaData
metaDataL = (Event -> MetaData)
-> (Event -> MetaData -> Event) -> Lens' Event MetaData
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Event -> MetaData
get Event -> MetaData -> Event
set
 where
  get :: Event -> MetaData
get Event
event = MetaData -> (Object -> MetaData) -> Maybe Object -> MetaData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MetaData
forall a. Monoid a => a
mempty Object -> MetaData
MetaData (Maybe Object -> MetaData) -> Maybe Object -> MetaData
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Object
event_metaData Event
event
  set :: Event -> MetaData -> Event
set Event
event MetaData
md = Event
event {event_metaData = Just $ unMetaData md}

-- | Collect 'MetaData' from a 'StatsClient' and 'myThreadContext'
--
-- Using this (and then 'mergeMetaData') will unify exception metadata with
-- metrics tags and the logging context.
collectMetaData
  :: (MonadIO m, MonadReader env m, HasStatsClient env) => m MetaData
collectMetaData :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasStatsClient env) =>
m MetaData
collectMetaData =
  MetaData -> MetaData -> MetaData
forall a. Semigroup a => a -> a -> a
(<>) (MetaData -> MetaData -> MetaData)
-> m MetaData -> m (MetaData -> MetaData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m MetaData
forall env (m :: * -> *).
(MonadReader env m, HasStatsClient env) =>
m MetaData
collectMetaDataFromStatsClient m (MetaData -> MetaData) -> m MetaData -> m MetaData
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m MetaData
forall (m :: * -> *). MonadIO m => m MetaData
collectMetaDataFromThreadContext

collectMetaDataFromStatsClient
  :: (MonadReader env m, HasStatsClient env) => m MetaData
collectMetaDataFromStatsClient :: forall env (m :: * -> *).
(MonadReader env m, HasStatsClient env) =>
m MetaData
collectMetaDataFromStatsClient = Getting MetaData env MetaData -> m MetaData
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting MetaData env MetaData -> m MetaData)
-> Getting MetaData env MetaData -> m MetaData
forall a b. (a -> b) -> a -> b
$ (StatsClient -> Const MetaData StatsClient)
-> env -> Const MetaData env
forall env. HasStatsClient env => Lens' env StatsClient
Lens' env StatsClient
statsClientL ((StatsClient -> Const MetaData StatsClient)
 -> env -> Const MetaData env)
-> ((MetaData -> Const MetaData MetaData)
    -> StatsClient -> Const MetaData StatsClient)
-> Getting MetaData env MetaData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Text)] -> Const MetaData [(Text, Text)])
-> StatsClient -> Const MetaData StatsClient
Lens' StatsClient [(Text, Text)]
tagsL (([(Text, Text)] -> Const MetaData [(Text, Text)])
 -> StatsClient -> Const MetaData StatsClient)
-> ((MetaData -> Const MetaData MetaData)
    -> [(Text, Text)] -> Const MetaData [(Text, Text)])
-> (MetaData -> Const MetaData MetaData)
-> StatsClient
-> Const MetaData StatsClient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Text)] -> MetaData)
-> (MetaData -> Const MetaData MetaData)
-> [(Text, Text)]
-> Const MetaData [(Text, Text)]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to [(Text, Text)] -> MetaData
toMetaData
 where
  toMetaData :: [(Text, Text)] -> MetaData
toMetaData = Key -> [Pair] -> MetaData
metaData Key
"tags" ([Pair] -> MetaData)
-> ([(Text, Text)] -> [Pair]) -> [(Text, Text)] -> MetaData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Pair) -> [(Text, Text)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Key) -> (Text -> Value) -> (Text, Text) -> Pair
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> (Text -> String) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) Text -> Value
String)

collectMetaDataFromThreadContext :: MonadIO m => m MetaData
collectMetaDataFromThreadContext :: forall (m :: * -> *). MonadIO m => m MetaData
collectMetaDataFromThreadContext =
  IO MetaData -> m MetaData
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaData -> m MetaData) -> IO MetaData -> m MetaData
forall a b. (a -> b) -> a -> b
$ Key -> [Pair] -> MetaData
metaData Key
"context" ([Pair] -> MetaData) -> (Object -> [Pair]) -> Object -> MetaData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList (Object -> MetaData) -> IO Object -> IO MetaData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Object
forall (m :: * -> *). (MonadIO m, MonadThrow m) => m Object
myThreadContext

-- | Merge 'MetaData' into the 'Event'
--
-- The given metadata will be combined with what already exists using '(<>)',
-- preserving the incoming values on collisions.
mergeMetaData :: MetaData -> BeforeNotify
mergeMetaData :: MetaData -> BeforeNotify
mergeMetaData MetaData
md = (Event -> Event) -> BeforeNotify
updateEvent ((Event -> Event) -> BeforeNotify)
-> (Event -> Event) -> BeforeNotify
forall a b. (a -> b) -> a -> b
$ (MetaData -> Identity MetaData) -> Event -> Identity Event
Lens' Event MetaData
metaDataL ((MetaData -> Identity MetaData) -> Event -> Identity Event)
-> MetaData -> Event -> Event
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ MetaData
md