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

{- | The request perimeter's fault vocabulary: what the serve boundary says about
an exception that escaped a handler before the response was committed.

The serve pipeline reports every routine failure as a value (metadata errors,
fetch faults, rule decisions), so an exception reaching the perimeter is either
one of the few __recognised typed channels__ -- a response-bound breach, the
response-assembly leg's
confined 'RenderEscape' marker -- or an invariant break nothing classified.
'classifyEscape' folds whichever it is into a 'RequestFault': the bounded cause
feeds the @ecluse.serve.perimeter.faults@ metric, the rendered detail feeds the
perimeter's log line, and neither ever reaches the client (the response is the route's
contract-admitted neutral 500).
-}
module Ecluse.Core.Server.Fault (
    RequestFault (..),
    classifyEscape,
    RenderEscape (..),
) where

import Ecluse.Core.Fault (boundedDetail)
import Ecluse.Core.Registry.Fault (ResponseBoundExceeded)
import Ecluse.Core.Telemetry.Metrics (RequestFaultCause (GateFault, RenderFault, UnclassifiedFault))
import Ecluse.Core.Text (displayExceptionT)

{- | One classified perimeter fault: the bounded cause a metric records and an
operator triages by, and the rendered escape for the log line. Diagnostic text
only -- it is never parsed, and no decision may branch on it.
-}
data RequestFault = RequestFault
    { RequestFault -> RequestFaultCause
rqCause :: RequestFaultCause
    -- ^ The closed classification (the metric label vocabulary).
    , RequestFault -> Text
rqDetail :: Text
    -- ^ The rendered escape, bounded to the shared log-line budget.
    }
    deriving stock (RequestFault -> RequestFault -> Bool
(RequestFault -> RequestFault -> Bool)
-> (RequestFault -> RequestFault -> Bool) -> Eq RequestFault
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestFault -> RequestFault -> Bool
== :: RequestFault -> RequestFault -> Bool
$c/= :: RequestFault -> RequestFault -> Bool
/= :: RequestFault -> RequestFault -> Bool
Eq, Int -> RequestFault -> ShowS
[RequestFault] -> ShowS
RequestFault -> String
(Int -> RequestFault -> ShowS)
-> (RequestFault -> String)
-> ([RequestFault] -> ShowS)
-> Show RequestFault
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestFault -> ShowS
showsPrec :: Int -> RequestFault -> ShowS
$cshow :: RequestFault -> String
show :: RequestFault -> String
$cshowList :: [RequestFault] -> ShowS
showList :: [RequestFault] -> ShowS
Show)

{- | The response-assembly leg's escape marker: the assembled-representation
render is total by contract (a pure assembly over already-validated inputs), so
an exception escaping it is an invariant break -- wrapped in this __confined__
typed marker at the one place the render runs, so the perimeter can name the
leg it escaped from. It never crosses the perimeter (which classifies it as
'RenderFault' and answers the neutral 500).
-}
newtype RenderEscape = RenderEscape SomeException
    deriving stock (Int -> RenderEscape -> ShowS
[RenderEscape] -> ShowS
RenderEscape -> String
(Int -> RenderEscape -> ShowS)
-> (RenderEscape -> String)
-> ([RenderEscape] -> ShowS)
-> Show RenderEscape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderEscape -> ShowS
showsPrec :: Int -> RenderEscape -> ShowS
$cshow :: RenderEscape -> String
show :: RenderEscape -> String
$cshowList :: [RenderEscape] -> ShowS
showList :: [RenderEscape] -> ShowS
Show)

instance Exception RenderEscape

{- | Fold an escaped exception into the perimeter's vocabulary: the recognised
typed channels classify by type, everything else is 'UnclassifiedFault' with its
rendering carried for the log line.
-}
classifyEscape :: SomeException -> RequestFault
classifyEscape :: SomeException -> RequestFault
classifyEscape SomeException
escape
    | Just (ResponseBoundExceeded
_ :: ResponseBoundExceeded) <- SomeException -> Maybe ResponseBoundExceeded
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
escape = RequestFaultCause -> SomeException -> RequestFault
forall {e}. Exception e => RequestFaultCause -> e -> RequestFault
fault RequestFaultCause
GateFault SomeException
escape
    | Just (RenderEscape SomeException
inner) <- SomeException -> Maybe RenderEscape
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
escape = RequestFaultCause -> SomeException -> RequestFault
forall {e}. Exception e => RequestFaultCause -> e -> RequestFault
fault RequestFaultCause
RenderFault SomeException
inner
    | Bool
otherwise = RequestFaultCause -> SomeException -> RequestFault
forall {e}. Exception e => RequestFaultCause -> e -> RequestFault
fault RequestFaultCause
UnclassifiedFault SomeException
escape
  where
    fault :: RequestFaultCause -> e -> RequestFault
fault RequestFaultCause
cause e
rendered = RequestFaultCause -> Text -> RequestFault
RequestFault RequestFaultCause
cause (Text -> Text
boundedDetail (e -> Text
forall e. Exception e => e -> Text
displayExceptionT e
rendered))