diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,18 @@ # Unreleased next version +# 0.5.0.3 + +### Enhancements + +- Log.Context can be shown, which should lead us to better test outputs. (#71) +- Platform.rootTracingSpanIO doesn't let `onFinish` break the worker. (#73) + # 0.5.0.2 ### Enhancements: -- Relax version bounds to ecompass `base-4.15.x`. +- use safe-color-text instead of ansi-terminal (#68) +- Relax version bounds to ecompass `base-4.15.x`. (#69) # 0.5.0.1 diff --git a/nri-prelude.cabal b/nri-prelude.cabal --- a/nri-prelude.cabal +++ b/nri-prelude.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: nri-prelude -version: 0.5.0.2 +version: 0.5.0.3 synopsis: A Prelude inspired by the Elm programming language description: Please see the README at . category: Web diff --git a/src/Log.hs b/src/Log.hs --- a/src/Log.hs +++ b/src/Log.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} -- | This module is dedicated to logging information in production, to help -- understand what the application is doing when something goes wrong. This sets @@ -143,14 +144,16 @@ -- | A key-value pair that can be added to a log context. All log expressions -- within the context will always log this key-value pair. -context :: (Aeson.ToJSON a) => Text -> a -> Context +context :: (Show a, Aeson.ToJSON a) => Text -> a -> Context context = Context -- | Extra information to attach to a log message. It is passed a string key -- defining what the data is and a value with a @ToJSON@ instance. data Context where - Context :: Aeson.ToJSON a => Text -> a -> Context + Context :: (Show a, Aeson.ToJSON a) => Text -> a -> Context +deriving instance Show Context + -- | A set of log contexts. newtype LogContexts = LogContexts [Context] @@ -224,7 +227,7 @@ | Info | Warn | Error - deriving (Generic) + deriving (Generic, Show) instance Aeson.ToJSON LogLevel diff --git a/src/Platform/Internal.hs b/src/Platform/Internal.hs --- a/src/Platform/Internal.hs +++ b/src/Platform/Internal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE RankNTypes #-} module Platform.Internal where @@ -7,6 +8,7 @@ import Basics import Control.Applicative ((<|>)) import qualified Control.AutoUpdate as AutoUpdate +import qualified Control.Concurrent.Async as Async import qualified Control.Exception.Safe as Exception import Data.Aeson ((.:), (.:?), (.=)) import qualified Data.Aeson as Aeson @@ -24,6 +26,8 @@ import Maybe (Maybe (..)) import Result (Result (Err, Ok)) import qualified System.Mem +import qualified System.Mem as Mem +import qualified System.Timeout as Timeout import Text (Text) import qualified Tuple import Prelude @@ -773,9 +777,56 @@ rootTracingSpanIO requestId onFinish name runIO = do clock' <- mkClock Exception.bracketWithError - (Stack.withFrozenCallStack mkHandler requestId clock' onFinish name) + (Stack.withFrozenCallStack mkHandler requestId clock' (onFinish >> reportSafely) name) (Prelude.flip finishTracingSpan) runIO + +-- After a root action (HTTP request, perform a job from a queue, etc) is done +-- we run our reporting logic, which sends debugging information to platforms +-- like Bugsnag and NewRelic. +-- +-- This information is important when helping us debug our applications, but it +-- shouldn't be able to cause problems for the non-reporting logic, i.e. the +-- parts responsible for sending a response back to the user. +-- +-- This function might kill the reporting thread if it thinks it's misbehaving. +-- It's up to the reporting logic to implement cleanup logic or notifications +-- of failed reporting using functions like `bracket`. +reportSafely :: IO () -> IO () +reportSafely report = do + -- Spawning a separate thread for the reporting logic ensures the main request + -- thread doesn't need to wait with responding to the user until reporting + -- logic finishes. It also ensures exceptions thrown in reporting logic won't + -- result in failure responses to requests. + _ <- + Async.async <| do + -- Setting an allocation limit helps protect us from reporting logic using + -- lots of CPU time and negatively affecting application performance. + Mem.setAllocationCounter reportingAllocationLimitInBytes + Mem.enableAllocationLimit + -- This thread is spawned without anybody watching how it does. We set a + -- maximum running time here to ensure it eventually completes. + Timeout.timeout reportingTimeoutInMicroSeconds report + Prelude.pure () + +-- | The maximum amount of bytes the reporting logic is allowed to allocate. +-- Note that this is more of a limit on CPU time then maximum live memory. See +-- the documentation on `setAllocationCounter` for more details: +-- +-- https://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html#v:enableAllocationLimit +-- +-- The current value is a somewhat arbitrary initial value, intentionally not +-- very strict. The hope is experience will help us tighten this value a bit. +reportingAllocationLimitInBytes :: Int +reportingAllocationLimitInBytes = 1024 * 1024 * 1024 + +-- | The maximum amount of time reporting logic is allowed to run for a single +-- request. +-- +-- The current value is a somewhat arbitrary initial value, intentionally not +-- very strict. The hope is experience will help us tighten this value a bit. +reportingTimeoutInMicroSeconds :: Prelude.Int +reportingTimeoutInMicroSeconds = 5_000_000 -- -- CLOCK diff --git a/tests/LogSpec.hs b/tests/LogSpec.hs --- a/tests/LogSpec.hs +++ b/tests/LogSpec.hs @@ -158,7 +158,11 @@ test "`Debug.toString` can pretty-print values containing secrets" <| \_ -> Log.mkSecret () |> Text.Show.Pretty.reify - |> Expect.notEqual Nothing + |> Expect.notEqual Nothing, + test "`Log.Context` can be shown" <| \_ -> + Log.context "hello" "world" + |> Debug.toString + |> Expect.equalToContentsOf "tests/golden-results/log-context-show" ] data TestException = TestException deriving (Show)