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

{- | The boot validation pass: one role-parameterised applicative that accumulates every refusal
and every advisory a configuration earns.

A rule whose severity varies by 'RegistryRole' reaches its outcome only through 'rule', so it
cannot be fatal on one boot path and absent from another: a role that tolerates a finding says so
in the rule. An outcome settled outside the pass, such as a refusal keyed on the mirror-pipeline
half a process runs, joins it through 'decided'. Advisories ride the success path, so a check that
passes can still advise.
-}
module Ecluse.Composition.Vet (
    -- * The accumulating pass
    Vet,
    runVet,
    withRole,
    decided,

    -- * Rules and their severity
    Severity (..),
    rule,
    byStoreRole,
) where

import Validation (Validation (Failure, Success), validationToEither)

import Ecluse.Composition.BootError (Advisory, BootError)
import Ecluse.Composition.Types (RegistryRole (MirrorPreviewer, MirrorPruner, MirrorWriter))

{- | A boot check awaiting its role: the advisories it logs, beside either every refusal it earned
or the value it vetted.
-}
newtype Vet a = Vet (RegistryRole -> ([Advisory], Validation [BootError] a))

instance Functor Vet where
    fmap :: forall a b. (a -> b) -> Vet a -> Vet b
fmap a -> b
f (Vet RegistryRole -> ([Advisory], Validation [BootError] a)
run) = (RegistryRole -> ([Advisory], Validation [BootError] b)) -> Vet b
forall a.
(RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
Vet ((RegistryRole -> ([Advisory], Validation [BootError] b)) -> Vet b)
-> (RegistryRole -> ([Advisory], Validation [BootError] b))
-> Vet b
forall a b. (a -> b) -> a -> b
$ \RegistryRole
role ->
        let ([Advisory]
advisories, Validation [BootError] a
outcome) = RegistryRole -> ([Advisory], Validation [BootError] a)
run RegistryRole
role
         in ([Advisory]
advisories, (a -> b) -> Validation [BootError] a -> Validation [BootError] b
forall a b.
(a -> b) -> Validation [BootError] a -> Validation [BootError] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Validation [BootError] a
outcome)

{- 'Vet' has no 'Monad' instance on purpose: a bind would let one check's failure hide the next
check's finding. '<*>' runs both sides whatever either decides, so one boot reports every finding. -}
instance Applicative Vet where
    pure :: forall a. a -> Vet a
pure a
a = (RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
forall a.
(RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
Vet (([Advisory], Validation [BootError] a)
-> RegistryRole -> ([Advisory], Validation [BootError] a)
forall a b. a -> b -> a
const ([], a -> Validation [BootError] a
forall e a. a -> Validation e a
Success a
a))
    Vet RegistryRole -> ([Advisory], Validation [BootError] (a -> b))
runF <*> :: forall a b. Vet (a -> b) -> Vet a -> Vet b
<*> Vet RegistryRole -> ([Advisory], Validation [BootError] a)
runA = (RegistryRole -> ([Advisory], Validation [BootError] b)) -> Vet b
forall a.
(RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
Vet ((RegistryRole -> ([Advisory], Validation [BootError] b)) -> Vet b)
-> (RegistryRole -> ([Advisory], Validation [BootError] b))
-> Vet b
forall a b. (a -> b) -> a -> b
$ \RegistryRole
role ->
        let ([Advisory]
fAdvisories, Validation [BootError] (a -> b)
f) = RegistryRole -> ([Advisory], Validation [BootError] (a -> b))
runF RegistryRole
role
            ([Advisory]
aAdvisories, Validation [BootError] a
a) = RegistryRole -> ([Advisory], Validation [BootError] a)
runA RegistryRole
role
         in ([Advisory]
fAdvisories [Advisory] -> [Advisory] -> [Advisory]
forall a. Semigroup a => a -> a -> a
<> [Advisory]
aAdvisories, Validation [BootError] (a -> b)
f Validation [BootError] (a -> b)
-> Validation [BootError] a -> Validation [BootError] b
forall a b.
Validation [BootError] (a -> b)
-> Validation [BootError] a -> Validation [BootError] b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Validation [BootError] a
a)

-- | Run a pass for one role: every advisory it logs, and either every refusal or the vetted value.
runVet :: RegistryRole -> Vet a -> ([Advisory], Either [BootError] a)
runVet :: forall a.
RegistryRole -> Vet a -> ([Advisory], Either [BootError] a)
runVet RegistryRole
role (Vet RegistryRole -> ([Advisory], Validation [BootError] a)
run) = (Validation [BootError] a -> Either [BootError] a)
-> ([Advisory], Validation [BootError] a)
-> ([Advisory], Either [BootError] a)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Validation [BootError] a -> Either [BootError] a
forall e a. Validation e a -> Either e a
validationToEither (RegistryRole -> ([Advisory], Validation [BootError] a)
run RegistryRole
role)

{- | Continue a pass with the role it runs for, which is how a witness one role alone may hold is
built. The role is no finding, so selecting a check by it hides none.
-}
withRole :: (RegistryRole -> Vet a) -> Vet a
withRole :: forall a. (RegistryRole -> Vet a) -> Vet a
withRole RegistryRole -> Vet a
select = (RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
forall a.
(RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
Vet ((RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a)
-> (RegistryRole -> ([Advisory], Validation [BootError] a))
-> Vet a
forall a b. (a -> b) -> a -> b
$ \RegistryRole
role -> let Vet RegistryRole -> ([Advisory], Validation [BootError] a)
run = RegistryRole -> Vet a
select RegistryRole
role in RegistryRole -> ([Advisory], Validation [BootError] a)
run RegistryRole
role

{- | Carry an outcome a producer decided for itself into the pass, so its refusals join the rest.
'rule' cannot express one already settled, or one whose severity turns on more than 'RegistryRole'.
-}
decided :: Either [BootError] a -> Vet a
decided :: forall a. Either [BootError] a -> Vet a
decided Either [BootError] a
outcome = (RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
forall a.
(RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
Vet ((RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a)
-> (([Advisory], Validation [BootError] a)
    -> RegistryRole -> ([Advisory], Validation [BootError] a))
-> ([Advisory], Validation [BootError] a)
-> Vet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Advisory], Validation [BootError] a)
-> RegistryRole -> ([Advisory], Validation [BootError] a)
forall a b. a -> b -> a
const (([Advisory], Validation [BootError] a) -> Vet a)
-> ([Advisory], Validation [BootError] a) -> Vet a
forall a b. (a -> b) -> a -> b
$ case Either [BootError] a
outcome of
    Left [BootError]
errs -> ([], [BootError] -> Validation [BootError] a
forall e a. e -> Validation e a
Failure [BootError]
errs)
    Right a
a -> ([], a -> Validation [BootError] a
forall e a. a -> Validation e a
Success a
a)

-- | What one role does about a finding a rule detected.
data Severity finding
    = -- | Refuse to boot, reporting this refusal.
      Refuse (finding -> BootError)
    | -- | Boot, and log this advisory.
      Advise (finding -> Advisory)
    | {- | Boot, and log nothing: only another role acts on the finding, and
      @ecluse check-config@ names that role for it.
      -}
      Ignore

{- | The severity split the store roles share, so the preview arm cannot be spelled apart from the
deleting one and drift: the store-role severity first, then the writing role's.
-}
byStoreRole :: Severity finding -> Severity finding -> RegistryRole -> Severity finding
byStoreRole :: forall finding.
Severity finding
-> Severity finding -> RegistryRole -> Severity finding
byStoreRole Severity finding
stores Severity finding
writer = \case
    RegistryRole
MirrorPruner -> Severity finding
stores
    RegistryRole
MirrorPreviewer -> Severity finding
stores
    RegistryRole
MirrorWriter -> Severity finding
writer

{- | One rule: its severity per role, the condition it detects in an input, and that input. One
detection feeds both the refusal and the advisory, so the two cannot describe different rules.
-}
rule :: (RegistryRole -> Severity finding) -> (input -> Maybe finding) -> input -> Vet ()
rule :: forall finding input.
(RegistryRole -> Severity finding)
-> (input -> Maybe finding) -> input -> Vet ()
rule RegistryRole -> Severity finding
severity input -> Maybe finding
detect input
input = (RegistryRole -> ([Advisory], Validation [BootError] ())) -> Vet ()
forall a.
(RegistryRole -> ([Advisory], Validation [BootError] a)) -> Vet a
Vet ((RegistryRole -> ([Advisory], Validation [BootError] ()))
 -> Vet ())
-> (RegistryRole -> ([Advisory], Validation [BootError] ()))
-> Vet ()
forall a b. (a -> b) -> a -> b
$ \RegistryRole
role ->
    case (input -> Maybe finding
detect input
input, RegistryRole -> Severity finding
severity RegistryRole
role) of
        (Maybe finding
Nothing, Severity finding
_) -> ([], () -> Validation [BootError] ()
forall e a. a -> Validation e a
Success ())
        (Just finding
finding, Refuse finding -> BootError
toRefusal) -> ([], [BootError] -> Validation [BootError] ()
forall e a. e -> Validation e a
Failure [finding -> BootError
toRefusal finding
finding])
        (Just finding
finding, Advise finding -> Advisory
toAdvisory) -> ([finding -> Advisory
toAdvisory finding
finding], () -> Validation [BootError] ()
forall e a. a -> Validation e a
Success ())
        (Just finding
_, Severity finding
Ignore) -> ([], () -> Validation [BootError] ()
forall e a. a -> Validation e a
Success ())