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

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

  -- * 'BeforeNotify'
  , mergeMetaData
  ) where

import Freckle.App.Prelude

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

newtype MetaData = MetaData
  { MetaData -> Object
unMetaData :: Object
  }
  deriving stock (MetaData -> MetaData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaData -> MetaData -> Bool
$c/= :: MetaData -> MetaData -> Bool
== :: MetaData -> MetaData -> Bool
$c== :: MetaData -> MetaData -> Bool
Eq, Int -> MetaData -> ShowS
[MetaData] -> ShowS
MetaData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaData] -> ShowS
$cshowList :: [MetaData] -> ShowS
show :: MetaData -> String
$cshow :: MetaData -> String
showsPrec :: Int -> MetaData -> ShowS
$cshowsPrec :: Int -> MetaData -> ShowS
Show)

instance Semigroup MetaData where
  -- | /Right/-biased, recursive union
  --
  -- The chosen bias ensures that adding metadata in smaller scopes (later)
  -- overrides values from larger scopes.
  --
  MetaData Object
x <> :: MetaData -> MetaData -> MetaData
<> MetaData Object
y = Object -> MetaData
MetaData forall a b. (a -> b) -> a -> b
$ Object -> Object -> Object
unionObjects Object
y Object
x
   where
    unionObjects :: Object -> Object -> Object
    unionObjects :: Object -> Object -> Object
unionObjects = forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
Aeson.unionWith Value -> Value -> Value
unionValues

    unionValues :: Value -> Value -> Value
unionValues (Object Object
a) (Object Object
b) = Object -> Value
Object forall a b. (a -> b) -> a -> b
$ Object -> Object -> Object
unionObjects Object
a Object
b
    unionValues Value
a Value
_ = Value
a

instance Monoid MetaData where
  mempty :: MetaData
mempty = Object -> MetaData
MetaData forall a. Monoid a => a
mempty

-- | Construct 'MetaData' from 'Pair's
metaData
  :: Aeson.Key
  -- ^ The Tab within which the values will display
  -> [Pair]
  -- ^ The Key-Values themselves
  -> MetaData
metaData :: Key -> [(Key, Value)] -> MetaData
metaData Key
key = Object -> MetaData
MetaData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. [(Key, v)] -> KeyMap v
Aeson.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
key forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Value
object

metaDataL :: Lens' Event MetaData
metaDataL :: Lens' Event MetaData
metaDataL = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Object -> MetaData
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 :: Maybe Object
event_metaData = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ MetaData -> Object
unMetaData MetaData
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 =
  forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env (m :: * -> *).
(MonadReader env m, HasStatsClient env) =>
m MetaData
collectMetaDataFromStatsClient forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasStatsClient env => Lens' env StatsClient
statsClientL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' StatsClient [(Text, Text)]
tagsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> [(Key, Value)] -> MetaData
metaData Key
"tags" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a. IsString a => String -> a
fromString 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 =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Key -> [(Key, Value)] -> MetaData
metaData Key
"context" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [(Key, v)]
Aeson.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a b. (a -> b) -> a -> b
$ Lens' Event MetaData
metaDataL forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ MetaData
md

-- $details
--
-- From <https://bugsnagerrorreportingapi.docs.apiary.io/#reference/0/notify/send-error-reports>
--
-- @events[].metaData@
--
-- > An object containing any further data you wish to attach to this error
-- > event. This should contain one or more objects, with each object being
-- > displayed in its own tab on the event details on Bugsnag.
-- >
-- > {
-- >     // Custom user data to be displayed in the User tab along with standard
-- >     // user fields on the Bugsnag website.
-- >     "user": {
-- >        ...
-- >     },
-- >
-- >     // Custom app data to be displayed in the App tab along with standard
-- >     // app fields on the Bugsnag website.
-- >     "app": {
-- >        ...
-- >     },
-- >
-- >     // Custom device data to be displayed in the Device tab along with
-- >     //standard device fields on the Bugsnag website.
-- >     "device": {
-- >        ...
-- >     },
-- >
-- >     Custom request data to be displayed in the Request tab along with
-- >     standard request fields on the Bugsnag website.
-- >     "request": {
-- >        ...
-- >     },
-- >
-- >     // This will be displayed as an extra tab on the Bugsnag website.
-- >     "Some data": {
-- >
-- >         // A key value pair that will be displayed in the first tab.
-- >         "key": "value",
-- >
-- >         // Key value pairs can be contained in nested objects which helps
-- >         // to organise the information presented in the tab.
-- >         "setOfKeys": {
-- >             "key": "value",
-- >             "key2": "value"
-- >         }
-- >     },
-- >
-- >     // This would be the second extra tab on the Bugsnag website.
-- >     "Some more data": {
-- >         ...
-- >     }
-- > }