{-# 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
-- it apart from the @Debug@ module which provide helpers for debugging problems
-- in development.
--
-- This module does not have an Elm counterpart.
module Log
  ( -- * Logging
    debug,
    info,
    warn,
    error,
    withContext,
    context,

    -- * Secrets
    Secret,
    mkSecret,
    unSecret,

    -- * For use in observability modules
    Context (..),
    LogContexts (..),
  )
where

import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Key (fromText)
import qualified GHC.Stack as Stack
import NriPrelude
import qualified Platform
import qualified Platform.Internal as Internal
import qualified Task
import qualified Text.Show
import qualified Prelude

-- | A log message that is probably only useful in development, or when we're
-- really confused about something and need ALL THE CONTEXT.
--
-- In addition to a log message you can pass additional key-value pairs with
-- information that might be relevant for debugging.
--
-- > debug "Computation partially succeeded" [context "answer" 2]
debug :: (Stack.HasCallStack) => Text -> [Context] -> Task e ()
debug :: forall e. HasCallStack => Text -> [Context] -> Task e ()
debug Text
message [Context]
contexts =
  (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
    HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
    Text
message
    ReportStatus
ReportAsSucceeded
    (Text -> LogLevel -> Context
forall a. (Show a, ToJSON a) => Text -> a -> Context
Context Text
"level" LogLevel
Debug Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)

-- | A log message useful for when things have gone off the rails.
-- We should have a ton of messages at this level.
-- It should help us out when we're dealing with something hard.
--
-- In addition to a log message you can pass additional key-value pairs with
-- information that might be relevant for debugging.
--
-- > info "I added 1 and 1" [context "answer" 2]
info :: (Stack.HasCallStack) => Text -> [Context] -> Task e ()
info :: forall e. HasCallStack => Text -> [Context] -> Task e ()
info Text
message [Context]
contexts =
  (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
    HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
    Text
message
    ReportStatus
ReportAsSucceeded
    (Text -> LogLevel -> Context
forall a. (Show a, ToJSON a) => Text -> a -> Context
Context Text
"level" LogLevel
Info Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)

-- | A log message when something went wrong, but it did not go wrong in a way
-- to totally break the thing we're doing. These should be triaged and fixed
-- soon, but aren't show-stoppers.
--
-- In addition to a log message you can pass additional key-value pairs with
-- information that might be relevant for debugging.
--
-- > warn "This field was sent, but we're gonna deprecate it!" []
warn :: (Stack.HasCallStack) => Text -> [Context] -> Task e ()
warn :: forall e. HasCallStack => Text -> [Context] -> Task e ()
warn Text
message [Context]
contexts =
  (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
    HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
    Text
message
    ReportStatus
ReportAsFailed
    (Text -> LogLevel -> Context
forall a. (Show a, ToJSON a) => Text -> a -> Context
Context Text
"level" LogLevel
Warn Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)

-- | A log message when we can't continue with what we were trying to do
-- because of a problem.
--
-- In addition to a log message you can pass additional key-value pairs with
-- information that might be relevant for debugging.
--
-- > error "The user tried to request this thing, but they aren't allowed!" []
error :: (Stack.HasCallStack) => Text -> [Context] -> Task e ()
error :: forall e. HasCallStack => Text -> [Context] -> Task e ()
error Text
message [Context]
contexts =
  (HasCallStack => Text -> ReportStatus -> [Context] -> Task e ())
-> Text -> ReportStatus -> [Context] -> Task e ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
    HasCallStack => Text -> ReportStatus -> [Context] -> Task e ()
Text -> ReportStatus -> [Context] -> Task e ()
forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log
    Text
message
    ReportStatus
ReportAsFailed
    (Text -> LogLevel -> Context
forall a. (Show a, ToJSON a) => Text -> a -> Context
Context Text
"level" LogLevel
Error Context -> [Context] -> [Context]
forall a. a -> [a] -> [a]
: [Context]
contexts)

-- | Mark a block of code as a logical unit by giving it a name. This name will
-- be used in logs and monitoring dashboards, so use this function to help
-- debug production problems.
--
-- In addition to a name you can pass this function a list of context. A
-- context is a key-value pair you want to attach to all logs made inside of
-- the block of code wrapped.
--
-- Example usage:
--
-- > withContext "play-music" [context "artist" "The Beatles"] <| do
-- >   -- your code here!
--
-- Additionally, this function adds an entry to our homemade stack trace for if something errors.
-- Why not use the built-in stack trace? Well, the built-in stack trace only records a frame if you
-- add @Stack.HasCallStack =>@ to the function, so if we want a full stack trace, we need to add
-- that to literally all functions. Instead of doing that, we will use @withContext@ to collect
-- the stack trace, since it is used fairly often already. It will not be complete either, but
-- it's the best we can do without too much trouble.
withContext ::
  (Stack.HasCallStack) =>
  Text ->
  [Context] ->
  Task e b ->
  Task e b
withContext :: forall e b.
HasCallStack =>
Text -> [Context] -> Task e b -> Task e b
withContext Text
name [Context]
contexts Task e b
task =
  (HasCallStack => Text -> Task e b -> Task e b)
-> Text -> Task e b -> Task e b
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
    HasCallStack => Text -> Task e b -> Task e b
Text -> Task e b -> Task e b
forall e a. HasCallStack => Text -> Task e a -> Task e a
Internal.tracingSpan
    Text
name
    ( Task e b -> Task e () -> Task e b
forall e a b. Task e a -> Task e b -> Task e a
Platform.finally
        Task e b
task
        ( do
            LogContexts -> Task e ()
forall d e. TracingSpanDetails d => d -> Task e ()
Platform.setTracingSpanDetails ([Context] -> LogContexts
LogContexts [Context]
contexts)
            Text -> Task e ()
forall e. Text -> Task e ()
Platform.setTracingSpanSummary Text
name
        )
    )

--
-- CONTEXT
--

-- | 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 :: (Show a, Aeson.ToJSON a) => Text -> a -> Context
context :: forall a. (Show a, ToJSON a) => Text -> a -> Context
context = Text -> a -> Context
forall a. (Show a, ToJSON a) => Text -> a -> 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 :: (Show a, Aeson.ToJSON a) => Text -> a -> Context

deriving instance Show Context

-- | A set of log contexts.
newtype LogContexts
  = LogContexts [Context]

instance Aeson.ToJSON LogContexts where
  toJSON :: LogContexts -> Value
toJSON (LogContexts [Context]
contexts) =
    [Context]
contexts
      [Context] -> ([Context] -> [Pair]) -> [Pair]
forall a b. a -> (a -> b) -> b
|> (Context -> Pair) -> [Context] -> [Pair]
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\(Context Text
key a
val) -> (Text -> Key
fromText Text
key) Key -> a -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
val)
      [Pair] -> ([Pair] -> Value) -> Value
forall a b. a -> (a -> b) -> b
|> [Pair] -> Value
Aeson.object

  toEncoding :: LogContexts -> Encoding
toEncoding (LogContexts [Context]
contexts) =
    [Context]
contexts
      [Context] -> ([Context] -> Series) -> Series
forall a b. a -> (a -> b) -> b
|> (Context -> Series) -> [Context] -> Series
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Prelude.foldMap (\(Context Text
key a
val) -> (Text -> Key
fromText Text
key) Key -> a -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a
val)
      Series -> (Series -> Encoding) -> Encoding
forall a b. a -> (a -> b) -> b
|> Series -> Encoding
Aeson.pairs

instance Internal.TracingSpanDetails LogContexts

--
-- SECRET
--

-- | Wrap a value in a secret to prevent it from being accidentally logged.
--
-- > Debug.log "Logging a secret" (mkSecret "My PIN is 1234")
-- > --> Logging a secret: Secret *****
mkSecret :: a -> Secret a
mkSecret :: forall a. a -> Secret a
mkSecret = a -> Secret a
forall a. a -> Secret a
Secret

-- | Retrieve the original value from a secret. Be very careful with this and ask
-- yourself: is there really no way I can pass this value on as a secret
-- further before I need to unwrap it?
--
-- The longer a value is wrapped in a Secret, the smaller the odds of it
-- accidentally being logged.
unSecret :: Secret a -> a
unSecret :: forall a. Secret a -> a
unSecret (Secret a
x) = a
x

-- | Distinguishes data that is secret and should not be logged.
--
-- Please be careful when defining or altering instances for this data type.
-- There's a good chance we will leak credentials, PII, or
-- other equally sensitive information.
newtype Secret a
  = Secret a
  deriving (Secret a -> Secret a -> Bool
(Secret a -> Secret a -> Bool)
-> (Secret a -> Secret a -> Bool) -> Eq (Secret a)
forall a. Eq a => Secret a -> Secret a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Secret a -> Secret a -> Bool
== :: Secret a -> Secret a -> Bool
$c/= :: forall a. Eq a => Secret a -> Secret a -> Bool
/= :: Secret a -> Secret a -> Bool
Prelude.Eq, (forall a b. (a -> b) -> Secret a -> Secret b)
-> (forall a b. a -> Secret b -> Secret a) -> Functor Secret
forall a b. a -> Secret b -> Secret a
forall a b. (a -> b) -> Secret a -> Secret b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Secret a -> Secret b
fmap :: forall a b. (a -> b) -> Secret a -> Secret b
$c<$ :: forall a b. a -> Secret b -> Secret a
<$ :: forall a b. a -> Secret b -> Secret a
Prelude.Functor)

instance Prelude.Applicative Secret where
  Secret a -> b
f <*> :: forall a b. Secret (a -> b) -> Secret a -> Secret b
<*> Secret a
x = b -> Secret b
forall a. a -> Secret a
Secret (a -> b
f a
x)

  pure :: forall a. a -> Secret a
pure = a -> Secret a
forall a. a -> Secret a
Secret

-- | N.B. This instance of 'Show' is not law abiding.
--
-- This instance exists because we sometimes use 'Secret' in data types
-- that have to derive 'Show' (due to other constraints on those data types).
--
-- This is not a pattern to follow; it's an exception.
instance Show (Secret a) where
  showsPrec :: Int -> Secret a -> ShowS
showsPrec Int
p Secret a
_ =
    Bool -> ShowS -> ShowS
Text.Show.showParen (Int
p Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
> Int
10) (String -> ShowS
Text.Show.showString String
"Secret \"*****\"")

instance Aeson.ToJSON (Secret a) where
  toJSON :: Secret a -> Value
toJSON Secret a
_ = Text -> Value
Aeson.String Text
"Secret *****"

--
-- TRIAGE
--

data LogLevel
  = Debug
  | Info
  | Warn
  | Error
  deriving ((forall x. LogLevel -> Rep LogLevel x)
-> (forall x. Rep LogLevel x -> LogLevel) -> Generic LogLevel
forall x. Rep LogLevel x -> LogLevel
forall x. LogLevel -> Rep LogLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogLevel -> Rep LogLevel x
from :: forall x. LogLevel -> Rep LogLevel x
$cto :: forall x. Rep LogLevel x -> LogLevel
to :: forall x. Rep LogLevel x -> LogLevel
Generic, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show)

instance Aeson.ToJSON LogLevel

-- ReportAsFailed marks the request as a failure in logging, but has no impact on the resulting Task. E.g. will not trigger a 500 error but will report an error to, e.g. BugSnag.
data ReportStatus = ReportAsFailed | ReportAsSucceeded

log :: (Stack.HasCallStack) => Text -> ReportStatus -> [Context] -> Task e ()
log :: forall e.
HasCallStack =>
Text -> ReportStatus -> [Context] -> Task e ()
log Text
msg ReportStatus
reportStatus [Context]
contexts =
  Text -> Task e () -> Task e ()
forall e a. HasCallStack => Text -> Task e a -> Task e a
Internal.tracingSpan Text
msg (Task e () -> Task e ()) -> Task e () -> Task e ()
forall a b. (a -> b) -> a -> b
<| do
    LogContexts -> Task e ()
forall d e. TracingSpanDetails d => d -> Task e ()
Platform.setTracingSpanDetails ([Context] -> LogContexts
LogContexts [Context]
contexts)
    case ReportStatus
reportStatus of
      ReportStatus
ReportAsSucceeded -> () -> Task e ()
forall a x. a -> Task x a
Task.succeed ()
      ReportStatus
ReportAsFailed -> Task e ()
forall e. Task e ()
Platform.markTracingSpanFailed