-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The operator-facing diagnostics the packument serve path emits: the per-origin
metadata-fetch failure log, the response-bound breach warning, the cross-upstream
integrity-divergence warning (threat #11), and the dropped-entry warning a
successful-but-degraded projection produces.

Each is a log line (with its structured payload) or a metered warning an operator
filters, alarms on, or reads back during an incident; none changes what is served.
They are emitted once per real fetch or merge, inside the request's @katip@ context,
so every line carries the request's trace correlation. The sibling per-condition
log helpers these dispatch to ('logDecodeFailure' and friends) live in
"Ecluse.Core.Server.Pipeline.Internal"; this module owns the packument-specific
renderings.
-}
module Ecluse.Core.Server.Pipeline.Diagnostics (
    logMetadataFailure,
    logInvalidEntries,
    warnDivergences,
) where

import Data.Aeson (Value)
import Data.Aeson.Text (encodeToLazyText)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Katip (KatipContext, Severity (WarningS), katipAddContext, logFM, ls, sl)

import Ecluse.Core.Package (
    HashAlg,
    InvalidEntry (invalidKey, invalidKind, invalidReason, invalidValue),
    InvalidEntryKind (InvalidDistTag, InvalidPublishTime, InvalidVersionManifest),
    PackageName,
    renderHashAlg,
    renderPackageName,
 )
import Ecluse.Core.Package.Merge (
    Divergence (divLosing, divVersion, divWinning),
    IntegrityFingerprint,
    MergePlan (mpDivergences),
    integrityHashes,
 )
import Ecluse.Core.Registry.Metadata (
    MetadataError (MetadataBoundExceeded, MetadataNameMismatch, MetadataUndecodable, MetadataUnreachable, MetadataUrlUnformable),
 )
import Ecluse.Core.Security (LimitError (BodyTooLarge, TooDeeplyNested, TooManyVersions))
import Ecluse.Core.Server.Context (Handler)
import Ecluse.Core.Server.Pipeline.Internal (
    logDecodeFailure,
    logNameMismatch,
    logUpstreamUnformable,
    logUpstreamUnreachable,
 )
import Ecluse.Core.Telemetry.Record (MetricsPort (..))

{- | Log a per-origin metadata-fetch failure at the point and severity it has always been
logged: a response-bound breach names the ceiling crossed ('logBreach'); an undecodable
body is the silent-guard decode log ('logDecodeFailure'); a self-reported /different/ name
is the name-mismatch log ('logNameMismatch'); an unformable configured base URL is the
config-fault log ('logUpstreamUnformable'); an unreachable origin is the outage log
('logUpstreamUnreachable'). Invoked once per real fetch, inside the single-flight
leader, in the request's context.
-}
logMetadataFailure :: PackageName -> Text -> MetadataError -> Handler ()
logMetadataFailure :: PackageName -> Text -> MetadataError -> Handler ()
logMetadataFailure PackageName
name Text
baseUrl = \case
    MetadataBoundExceeded LimitError
err -> PackageName -> LimitError -> Handler ()
forall (m :: * -> *).
KatipContext m =>
PackageName -> LimitError -> m ()
logBreach PackageName
name LimitError
err
    MetadataError
MetadataUndecodable -> PackageName -> Handler ()
forall (m :: * -> *). KatipContext m => PackageName -> m ()
logDecodeFailure PackageName
name
    MetadataNameMismatch Text
reported -> PackageName -> Text -> Text -> Handler ()
forall (m :: * -> *).
KatipContext m =>
PackageName -> Text -> Text -> m ()
logNameMismatch PackageName
name Text
baseUrl Text
reported
    MetadataUrlUnformable UrlFormationError
urlErr -> PackageName -> Text -> UrlFormationError -> Handler ()
forall (m :: * -> *).
KatipContext m =>
PackageName -> Text -> UrlFormationError -> m ()
logUpstreamUnformable PackageName
name Text
baseUrl UrlFormationError
urlErr
    MetadataUnreachable TransportFault
fault -> PackageName -> Text -> TransportFault -> Handler ()
forall (m :: * -> *).
KatipContext m =>
PackageName -> Text -> TransportFault -> m ()
logUpstreamUnreachable PackageName
name Text
baseUrl TransportFault
fault

{- Log a response-bound breach at 'WarningS' before the contribution is degraded
fail-closed, so an operator can distinguish a bound breach (a hostile\/oversized
upstream, or a too-tight cap) from an ordinary parse failure or upstream outage. The
structured payload names the package, which @bound@ was crossed, and the observed
value against its @cap@ -- the high-cardinality identifiers that belong on the log
line, not a metric label. Emitted through the ambient @katip@ context (the request's,
so the line carries its trace-correlation @dd@), under the @ecluse@ namespace the rest
of the stream uses. -}
logBreach :: (KatipContext m) => PackageName -> LimitError -> m ()
logBreach :: forall (m :: * -> *).
KatipContext m =>
PackageName -> LimitError -> m ()
logBreach PackageName
name LimitError
err =
    SimpleLogPayload -> m () -> m ()
forall i (m :: * -> *) a.
(LogItem i, KatipContext m) =>
i -> m a -> m a
katipAddContext SimpleLogPayload
payload (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Severity -> LogStr -> m ()
forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
WarningS (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
ls Text
message)
  where
    -- The package the refused document was for, plus the breach detail, as the
    -- structured @data@ object on the line.
    payload :: SimpleLogPayload
payload =
        Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"module" Text
pipelineModule
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"package" (PackageName -> Text
renderPackageName PackageName
name)
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"bound" Text
boundName
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"observed" Text
observed
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"cap" Text
cap

    -- A human-readable one-line summary; the structured fields carry the detail.
    message :: Text
    message :: Text
message = Text
"refused an upstream metadata document: it exceeded the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
boundName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" response bound (observed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
observed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", cap " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cap Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

    -- Which ceiling, the observed value, and the cap -- pulled from the typed error so
    -- the three are always consistent with what was enforced.
    boundName :: Text
    observed :: Text
    cap :: Text
    (Text
boundName, Text
observed, Text
cap) = case LimitError
err of
        BodyTooLarge Int
c -> (Text
"body-size", Text
"over " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes", Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" bytes")
        TooManyVersions Int
seen Int
c -> (Text
"version-count", Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
seen, Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
c)
        TooDeeplyNested Int
c -> (Text
"nesting-depth", Text
"over " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" levels", Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" levels")

{- | Log a cross-upstream integrity divergence (threat #11) at 'WarningS' and meter it. A
public copy contradicts the trusted one on a shared integrity algorithm for a shared
version; the trusted copy still won the merge (and is served, or withheld under
'FailClosed'), so this is the supply-chain signal the operator alarms on, never a silent
reconciliation. The structured payload names the package and the contradicting versions;
the @ecluse.registry.merge.divergence@ counter is incremented once per contradicting
version. Nothing is logged or metered for a clean merge.
-}
warnDivergences :: (KatipContext m) => MetricsPort -> PackageName -> MergePlan -> m ()
warnDivergences :: forall (m :: * -> *).
KatipContext m =>
MetricsPort -> PackageName -> MergePlan -> m ()
warnDivergences MetricsPort
metrics PackageName
name MergePlan
plan =
    case Set Divergence -> [Divergence]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (MergePlan -> Set Divergence
mpDivergences MergePlan
plan) of
        [] -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
        [Divergence]
divs -> do
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Divergence] -> (Divergence -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Divergence]
divs (IO () -> Divergence -> IO ()
forall a b. a -> b -> a
const (MetricsPort -> IO ()
mpMergeDivergence MetricsPort
metrics)))
            SimpleLogPayload -> m () -> m ()
forall i (m :: * -> *) a.
(LogItem i, KatipContext m) =>
i -> m a -> m a
katipAddContext ([Divergence] -> SimpleLogPayload
payload [Divergence]
divs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Severity -> LogStr -> m ()
forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
WarningS (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
ls ([Divergence] -> Text
message [Divergence]
divs))
  where
    payload :: [Divergence] -> SimpleLogPayload
payload [Divergence]
divs =
        Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"module" Text
pipelineModule
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"package" (PackageName -> Text
renderPackageName PackageName
name)
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"versions" (Text -> [Text] -> Text
T.intercalate Text
"," ((Divergence -> Text) -> [Divergence] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Divergence -> Text
divVersion [Divergence]
divs))
    message :: [Divergence] -> Text
message [Divergence]
divs =
        Text
"cross-upstream integrity divergence: the trusted copy of "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
renderPackageName PackageName
name
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is served, but a public copy contradicts it on a shared integrity algorithm for "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([Divergence] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Divergence]
divs)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" version(s): "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"; " ((Divergence -> Text) -> [Divergence] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Divergence -> Text
renderDivergence [Divergence]
divs)

-- One divergence rendered for the log line: the version key and the contradicting trusted
-- vs public integrity fingerprints, read back via 'integrityHashes'.
renderDivergence :: Divergence -> Text
renderDivergence :: Divergence -> Text
renderDivergence Divergence
d =
    Divergence -> Text
divVersion Divergence
d
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (trusted "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IntegrityFingerprint -> Text
renderFingerprint (Divergence -> IntegrityFingerprint
divWinning Divergence
d)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" vs public "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IntegrityFingerprint -> Text
renderFingerprint (Divergence -> IntegrityFingerprint
divLosing Divergence
d)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

renderFingerprint :: IntegrityFingerprint -> Text
renderFingerprint :: IntegrityFingerprint -> Text
renderFingerprint IntegrityFingerprint
fp = Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (((Text, Maybe HashAlg, Text) -> Text)
-> [(Text, Maybe HashAlg, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe HashAlg, Text) -> Text
renderHash (IntegrityFingerprint -> [(Text, Maybe HashAlg, Text)]
integrityHashes IntegrityFingerprint
fp)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

renderHash :: (Text, Maybe HashAlg, Text) -> Text
renderHash :: (Text, Maybe HashAlg, Text) -> Text
renderHash (Text
file, Maybe HashAlg
alg, Text
body) = Text
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (HashAlg -> Text) -> Maybe HashAlg -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"none" HashAlg -> Text
renderHashAlg Maybe HashAlg
alg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
body

{- | Log the malformed packument entries an upstream served that the projection dropped
rather than failing the whole document on, at 'WarningS', so an operator can see that an
upstream served a malformed entry, which kind (a version manifest, a dist-tag, or a
per-version publish time), and __the raw value it sent__. The structured payload names the
package, the per-kind drop counts, and a bounded sample of the dropped entries each
rendering its raw 'Data.Aeson.Value' (truncated if large, and capped to 'maxRenderedDrops'
entries so a flood of drops cannot bloat the line). The dropped versions are still served
minus those entries (graceful degradation), so this is an observability signal, not a
refusal. Emitted once per real fetch (inside the cache leader, so a coalesced follower
never re-logs) through the request's @katip@ context. The caller guards on a non-empty
list, so this never logs for a clean document.
-}
logInvalidEntries :: (KatipContext m) => PackageName -> Text -> [InvalidEntry] -> m ()
logInvalidEntries :: forall (m :: * -> *).
KatipContext m =>
PackageName -> Text -> [InvalidEntry] -> m ()
logInvalidEntries PackageName
name Text
baseUrl [InvalidEntry]
entries =
    SimpleLogPayload -> m () -> m ()
forall i (m :: * -> *) a.
(LogItem i, KatipContext m) =>
i -> m a -> m a
katipAddContext SimpleLogPayload
payload (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Severity -> LogStr -> m ()
forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
WarningS (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
ls Text
message)
  where
    payload :: SimpleLogPayload
payload =
        Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"module" Text
pipelineModule
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"package" (PackageName -> Text
renderPackageName PackageName
name)
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"upstream" Text
baseUrl
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Int -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"droppedVersionManifests" Int
manifests
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Int -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"droppedDistTags" Int
distTags
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> Int -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"droppedPublishTimes" Int
publishTimes
            SimpleLogPayload -> SimpleLogPayload -> SimpleLogPayload
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> SimpleLogPayload
forall a. ToJSON a => Text -> a -> SimpleLogPayload
sl Text
"droppedEntries" ((InvalidEntry -> Text) -> [InvalidEntry] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map InvalidEntry -> Text
renderDroppedEntry (Int -> [InvalidEntry] -> [InvalidEntry]
forall a. Int -> [a] -> [a]
take Int
maxRenderedDrops [InvalidEntry]
entries))

    (Int
manifests, Int
distTags, Int
publishTimes, Int
entriesLen) =
        ((Int, Int, Int, Int) -> InvalidEntry -> (Int, Int, Int, Int))
-> (Int, Int, Int, Int) -> [InvalidEntry] -> (Int, Int, Int, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            (Int, Int, Int, Int) -> InvalidEntry -> (Int, Int, Int, Int)
forall {a} {d} {b} {c}.
(Num a, Num d, Num b, Num c) =>
(a, b, c, d) -> InvalidEntry -> (a, b, c, d)
accumulateDropCounts
            (Int
0 :: Int, Int
0 :: Int, Int
0 :: Int, Int
0 :: Int)
            [InvalidEntry]
entries

    accumulateDropCounts :: (a, b, c, d) -> InvalidEntry -> (a, b, c, d)
accumulateDropCounts (a
m, b
d, c
p, d
l) InvalidEntry
e =
        case InvalidEntry -> InvalidEntryKind
invalidKind InvalidEntry
e of
            InvalidEntryKind
InvalidVersionManifest -> (a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
d, c
p, d
l d -> d -> d
forall a. Num a => a -> a -> a
+ d
1)
            InvalidEntryKind
InvalidDistTag -> (a
m, b
d b -> b -> b
forall a. Num a => a -> a -> a
+ b
1, c
p, d
l d -> d -> d
forall a. Num a => a -> a -> a
+ d
1)
            InvalidEntryKind
InvalidPublishTime -> (a
m, b
d, c
p c -> c -> c
forall a. Num a => a -> a -> a
+ c
1, d
l d -> d -> d
forall a. Num a => a -> a -> a
+ d
1)

    message :: Text
    message :: Text
message =
        Text
"dropped " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
entriesLen Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" malformed entr" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
plural Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from an upstream packument (the rest is served)"
    plural :: Text
plural = if Int
entriesLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"y" else Text
"ies"

-- One dropped entry rendered for the operator: its kind, key, reason, and the raw
-- value the upstream sent (truncated), so the actual offending bytes are visible.
renderDroppedEntry :: InvalidEntry -> Text
renderDroppedEntry :: InvalidEntry -> Text
renderDroppedEntry InvalidEntry
e =
    InvalidEntryKind -> Text
renderInvalidKind (InvalidEntry -> InvalidEntryKind
invalidKind InvalidEntry
e)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InvalidEntry -> Text
invalidKey InvalidEntry
e
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
truncatedValue (InvalidEntry -> Value
invalidValue InvalidEntry
e)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InvalidEntry -> Text
invalidReason InvalidEntry
e
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

renderInvalidKind :: InvalidEntryKind -> Text
renderInvalidKind :: InvalidEntryKind -> Text
renderInvalidKind = \case
    InvalidEntryKind
InvalidVersionManifest -> Text
"version-manifest"
    InvalidEntryKind
InvalidDistTag -> Text
"dist-tag"
    InvalidEntryKind
InvalidPublishTime -> Text
"publish-time"

-- The raw value as compact JSON, truncated to 'maxRenderedValueChars' (only that many
-- characters are ever forced, so a huge value never balloons the log line).
truncatedValue :: Value -> Text
truncatedValue :: Value -> Text
truncatedValue Value
v =
    let rendered :: Text
rendered = LazyText -> Text
TL.toStrict (Int64 -> LazyText -> LazyText
TL.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxRenderedValueChars Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) (Value -> LazyText
forall a. ToJSON a => a -> LazyText
encodeToLazyText Value
v))
     in if Text -> Int -> Ordering
T.compareLength Text
rendered Int
maxRenderedValueChars Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
            then Int -> Text -> Text
T.take Int
maxRenderedValueChars Text
rendered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"…"
            else Text
rendered

-- How many dropped entries the drop-tracking log renders in full, and how many characters
-- of each raw value, so an unbounded flood of malformed entries (or one huge value) cannot
-- bloat a single log line. The per-kind counts in the payload still report the full totals.
maxRenderedDrops :: Int
maxRenderedDrops :: Int
maxRenderedDrops = Int
20

maxRenderedValueChars :: Int
maxRenderedValueChars :: Int
maxRenderedValueChars = Int
200

-- The @module@ tag this module's breach log carries -- the operator-facing log filter
-- key, held stable as the current value rather than the source module path, so an
-- operator's saved filter keeps matching across the move into ecluse-core (the only
-- change to these lines is the trace-correlation @dd@ the ambient context adds). The
-- decode-failure log lives in "Ecluse.Core.Server.Pipeline.Internal", tagged likewise.
pipelineModule :: Text
pipelineModule :: Text
pipelineModule = Text
"Ecluse.Server.Pipeline"