-- 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 pipeline reports every routine
failure as a value, so an escape is either the response-assembly leg's confined 'RenderEscape'
marker or an invariant break nothing classified. 'classifyEscape' folds whichever it is into a
'RequestFault', whose bounded cause feeds the @ecluse.serve.perimeter.faults@ metric and whose
rendered detail feeds the perimeter's log line. Neither 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.Telemetry.Metrics (RequestFaultCause (RenderFault, UnclassifiedFault))
import Ecluse.Core.Text (displayExceptionT)

{- | One classified perimeter fault: the bounded cause a metric records and the rendered escape
for the log line. The detail is diagnostic only, 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 confined marker wrapping an exception that escaped the response-assembly render, which
is total by contract. It never crosses the perimeter, which folds it to 'RenderFault'.
-}
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, 'UnclassifiedFault' by default.
classifyEscape :: SomeException -> RequestFault
classifyEscape :: SomeException -> RequestFault
classifyEscape 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))