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

{- | The roles a boot runs under: which command started the process, which half of the mirror
pipeline that process runs, and which registry role its validation rules apply under.

The command line writes these and the boot pipeline reads them, so they live in a module neither
side owns.
-}
module Ecluse.Composition.Types (
    -- * The booting command
    BootRole (..),
    everyBootRole,
    bootInvocation,
    registryRoleOf,
    pipelineRoleOf,

    -- * The roles it decomposes into
    MirrorRole (..),
    roleInvocation,
    RegistryRole (..),
) where

-- relude's prelude exports a Bounded/Enum-based `universe`. Hide it so the
-- Generic-derived `Data.Universe.Class.universe` is the one in scope here.
import Prelude hiding (universe)

import Data.List (partition)
import Data.Universe.Class (Universe (..))
import Data.Universe.Generic (universeGeneric)

{- | What a booting command does with the configured mirror targets. It decides each rule's
severity and which witnesses the boot's vetting pass issues.
-}
data BootRole
    = -- | @ecluse proxy@, @ecluse proxy --no-worker@ and @ecluse mirror@: they write.
      BootMirrorPipeline MirrorRole
    | -- | @ecluse dredger@: it permanently deletes.
      BootStorePruner
    | -- | @ecluse dredger --dry-run@: it reads every mirror target and changes none of them.
      BootStorePreview
    | -- | @ecluse pilot@ and @ecluse check-config@: they neither mirror nor delete.
      BootWithoutPipeline
    deriving stock (BootRole -> BootRole -> Bool
(BootRole -> BootRole -> Bool)
-> (BootRole -> BootRole -> Bool) -> Eq BootRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BootRole -> BootRole -> Bool
== :: BootRole -> BootRole -> Bool
$c/= :: BootRole -> BootRole -> Bool
/= :: BootRole -> BootRole -> Bool
Eq, (forall x. BootRole -> Rep BootRole x)
-> (forall x. Rep BootRole x -> BootRole) -> Generic BootRole
forall x. Rep BootRole x -> BootRole
forall x. BootRole -> Rep BootRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BootRole -> Rep BootRole x
from :: forall x. BootRole -> Rep BootRole x
$cto :: forall x. Rep BootRole x -> BootRole
to :: forall x. Rep BootRole x -> BootRole
Generic, Int -> BootRole -> ShowS
[BootRole] -> ShowS
BootRole -> String
(Int -> BootRole -> ShowS)
-> (BootRole -> String) -> ([BootRole] -> ShowS) -> Show BootRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BootRole -> ShowS
showsPrec :: Int -> BootRole -> ShowS
$cshow :: BootRole -> String
show :: BootRole -> String
$cshowList :: [BootRole] -> ShowS
showList :: [BootRole] -> ShowS
Show)

instance Universe BootRole where universe :: [BootRole]
universe = [BootRole]
forall a. (Generic a, GUniverse (Rep a)) => [a]
universeGeneric

{- | Every role a boot runs under, the mirror-pipeline halves first. @ecluse check-config@ picks
no subcommand, so it runs the pure pass once per entry rather than once.
-}
everyBootRole :: [BootRole]
-- 'universe' enumerates the constructors, so a role added to 'BootRole' joins with no edit here.
everyBootRole :: [BootRole]
everyBootRole = [BootRole]
pipelineRoles [BootRole] -> [BootRole] -> [BootRole]
forall a. Semigroup a => a -> a -> a
<> [BootRole]
rest
  where
    ([BootRole]
pipelineRoles, [BootRole]
rest) = (BootRole -> Bool) -> [BootRole] -> ([BootRole], [BootRole])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Maybe MirrorRole -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MirrorRole -> Bool)
-> (BootRole -> Maybe MirrorRole) -> BootRole -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BootRole -> Maybe MirrorRole
pipelineRoleOf) [BootRole]
forall a. Universe a => [a]
universe

-- | How an operator spells a booting command, for a report that names the role a refusal belongs to.
bootInvocation :: BootRole -> Text
bootInvocation :: BootRole -> Text
bootInvocation = \case
    BootMirrorPipeline MirrorRole
role -> MirrorRole -> Text
roleInvocation MirrorRole
role
    BootRole
BootStorePruner -> Text
"ecluse dredger"
    BootRole
BootStorePreview -> Text
"ecluse dredger --dry-run"
    BootRole
BootWithoutPipeline -> Text
"ecluse pilot"

-- | The registry role a command's rules apply under. Only the Dredger deletes.
registryRoleOf :: BootRole -> RegistryRole
registryRoleOf :: BootRole -> RegistryRole
registryRoleOf = \case
    BootMirrorPipeline MirrorRole
_ -> RegistryRole
MirrorWriter
    BootRole
BootStorePruner -> RegistryRole
MirrorPruner
    BootRole
BootStorePreview -> RegistryRole
MirrorPreviewer
    BootRole
BootWithoutPipeline -> RegistryRole
MirrorWriter

-- | The mirror-pipeline half a command runs, 'Nothing' where it runs none.
pipelineRoleOf :: BootRole -> Maybe MirrorRole
pipelineRoleOf :: BootRole -> Maybe MirrorRole
pipelineRoleOf = \case
    BootMirrorPipeline MirrorRole
role -> MirrorRole -> Maybe MirrorRole
forall a. a -> Maybe a
Just MirrorRole
role
    BootRole
BootStorePruner -> Maybe MirrorRole
forall a. Maybe a
Nothing
    BootRole
BootStorePreview -> Maybe MirrorRole
forall a. Maybe a
Nothing
    BootRole
BootWithoutPipeline -> Maybe MirrorRole
forall a. Maybe a
Nothing

-- | The mirror-pipeline halves one process runs, selected by the command line.
data MirrorRole
    = -- | @ecluse proxy@: the front door and the mirror worker in one process.
      ServeAndMirror
    | -- | @ecluse proxy --no-worker@: the front door alone, still enqueueing.
      ServeOnly
    | -- | @ecluse mirror@: the worker alone, serving only its health probes.
      MirrorOnly
    deriving stock (MirrorRole -> MirrorRole -> Bool
(MirrorRole -> MirrorRole -> Bool)
-> (MirrorRole -> MirrorRole -> Bool) -> Eq MirrorRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MirrorRole -> MirrorRole -> Bool
== :: MirrorRole -> MirrorRole -> Bool
$c/= :: MirrorRole -> MirrorRole -> Bool
/= :: MirrorRole -> MirrorRole -> Bool
Eq, (forall x. MirrorRole -> Rep MirrorRole x)
-> (forall x. Rep MirrorRole x -> MirrorRole) -> Generic MirrorRole
forall x. Rep MirrorRole x -> MirrorRole
forall x. MirrorRole -> Rep MirrorRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MirrorRole -> Rep MirrorRole x
from :: forall x. MirrorRole -> Rep MirrorRole x
$cto :: forall x. Rep MirrorRole x -> MirrorRole
to :: forall x. Rep MirrorRole x -> MirrorRole
Generic, Int -> MirrorRole -> ShowS
[MirrorRole] -> ShowS
MirrorRole -> String
(Int -> MirrorRole -> ShowS)
-> (MirrorRole -> String)
-> ([MirrorRole] -> ShowS)
-> Show MirrorRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MirrorRole -> ShowS
showsPrec :: Int -> MirrorRole -> ShowS
$cshow :: MirrorRole -> String
show :: MirrorRole -> String
$cshowList :: [MirrorRole] -> ShowS
showList :: [MirrorRole] -> ShowS
Show)

instance Universe MirrorRole where universe :: [MirrorRole]
universe = [MirrorRole]
forall a. (Generic a, GUniverse (Rep a)) => [a]
universeGeneric

-- | How an operator spells this role on the command line, for the boot refusal's message.
roleInvocation :: MirrorRole -> Text
roleInvocation :: MirrorRole -> Text
roleInvocation = \case
    MirrorRole
ServeAndMirror -> Text
"ecluse proxy"
    MirrorRole
ServeOnly -> Text
"ecluse proxy --no-worker"
    MirrorRole
MirrorOnly -> Text
"ecluse mirror"

{- | The registry role a vetting pass vets for. The proxy and the mirror worker write to a mount's
mirror target, and the Dredger deletes from it, which is what makes a shared store unsafe.
-}
data RegistryRole
    = -- | @ecluse proxy@ and @ecluse mirror@: they read and write, and delete nothing.
      MirrorWriter
    | -- | @ecluse dredger@: it permanently deletes from every mount's mirror target.
      MirrorPruner
    | -- | @ecluse dredger --dry-run@: same checks, holding nothing that writes to a target.
      MirrorPreviewer
    deriving stock (RegistryRole -> RegistryRole -> Bool
(RegistryRole -> RegistryRole -> Bool)
-> (RegistryRole -> RegistryRole -> Bool) -> Eq RegistryRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegistryRole -> RegistryRole -> Bool
== :: RegistryRole -> RegistryRole -> Bool
$c/= :: RegistryRole -> RegistryRole -> Bool
/= :: RegistryRole -> RegistryRole -> Bool
Eq, Int -> RegistryRole -> ShowS
[RegistryRole] -> ShowS
RegistryRole -> String
(Int -> RegistryRole -> ShowS)
-> (RegistryRole -> String)
-> ([RegistryRole] -> ShowS)
-> Show RegistryRole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegistryRole -> ShowS
showsPrec :: Int -> RegistryRole -> ShowS
$cshow :: RegistryRole -> String
show :: RegistryRole -> String
$cshowList :: [RegistryRole] -> ShowS
showList :: [RegistryRole] -> ShowS
Show)