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

{- | Aggregated startup refusals, the advisories a boot logs beside them, and their
operator-facing rendering.
-}
module Ecluse.Composition.BootError (
    BootError (..),
    StoreMaintenanceReason (..),
    Advisory (..),
    refuseOnThrow,
    renderBootError,
    renderBootErrors,
    renderAdvisory,
) where

import Data.Text qualified as T
import Data.Time (NominalDiffTime)
import UnliftIO (tryAny)

import Ecluse.Config (
    PolicyError,
    StoreTag,
    renderPolicyError,
    storeTagName,
 )
import Ecluse.Config.Resolve (mountKeyRef)
import Ecluse.Core.Credential (Secret)
import Ecluse.Core.Ecosystem (Ecosystem, ecosystemName)
import Ecluse.Core.Registry.Maintenance.Upstream (
    ExternalConnection (externalConnectionText),
    PermissionName (permissionNameText),
    RepositoryName (repositoryNameText),
    UndecidabilityReason (ChainBoundExceeded, NetworkFailure, NoMechanism),
    UnsafeReason (ConfigurationEvidence, InsufficientPermissions),
 )
import Ecluse.Core.Security (authorityLabel)
import Ecluse.Core.Security.Egress (RegistryUrl, registryUrlText)
import Ecluse.Core.Text (displayExceptionT)

{- | A reason the composition root refuses to start. The root aggregates them, so a
single run reports every problem an operator must fix.
-}
data BootError
    = -- | A rule policy did not resolve (surfaced by 'Ecluse.Config.loadConfig').
      PolicyBootError PolicyError
    | -- | A configured mount's ecosystem has no adapter, so Écluse cannot serve it.
      MissingAdapter Ecosystem
    | {- | A mount has no initialised mirror-write provider. Every active mount derives its
      credential from its mirror target, so this is a safety net, not a reachable state.
      -}
      UnresolvedCredential Ecosystem
    | -- | The queue URL names a backend this binary cannot run.
      QueueProviderUnavailable Text
    | {- | An SQS endpoint override (@AWS_ENDPOINT_URL_SQS@) is set but @AWS_REGION@ is not.
      An emulator or VPC endpoint carries no region in its host, so the ambient one must scope it.
      -}
      QueueRegionMissing
    | {- | @ECLUSE_QUEUE__URL@ is set but its shape names no backend this binary knows. Guessing
      one would send mirror jobs somewhere the operator did not point at. Carries the value.
      -}
      QueueUrlUnrecognised Text
    | {- | The configured SQS endpoint override (@AWS_ENDPOINT_URL_SQS@) is not a parseable
      endpoint URL. It can carry a credential, so the value stays redacted behind the secret.
      -}
      QueueEndpointMalformed Secret
    | {- | The S3 advisory client's endpoint override (@AWS_ENDPOINT_URL@) is not a parseable
      endpoint URL. Refused rather than dropped, so a typo never silently dials real AWS.
      -}
      AwsEndpointMalformed Secret
    | -- | The eager mint threw, carrying every configured consumer key and the rendered exception.
      CodeArtifactMintFailed (NonEmpty Text) Text
    | {- | A mount declares a mirror target, but this build writes nothing for its ecosystem.
      The mirror could never publish, so the mount is refused rather than booted half-wired.
      -}
      MirrorTargetWithoutPublish Ecosystem
    | -- | A publication target has no adapter that can write its ecosystem's protocol.
      PublicationTargetWithoutPublish Ecosystem
    | {- | A publication target is set and the mount declares no first-party namespaces, so the
      anti-shadowing guard has nothing to enforce and any name could be shadowed.
      -}
      FirstPartyMissing Ecosystem
    | -- | First-party names have no private authority, so every lookup would return 404.
      FirstPartyWithoutPrivateUpstream Ecosystem
    | {- | A static publish credential is set without a verifiable inbound edge
      (@ECLUSE_SERVER__AUTH_TOKEN@). An unauthenticated request could otherwise publish as Écluse.
      -}
      PublishStaticCredentialNeedsEdge Ecosystem StoreTag
    | {- | A mount's publication target, at the carried registry, shares a host with the named
      mount's public upstream. The publisher's relayed credential would reach a public registry.
      -}
      PublicationTargetOnPublicUpstream Ecosystem Ecosystem Text
    | {- | A mount's publication target is also the named mount's endpoint under the named key, at
      the carried registry. A publish would be relayed into a role declared for something else.
      -}
      PublicationTargetOnMountEndpoint Ecosystem Ecosystem Text Text
    | {- | A mount's mirror target, at the carried registry, shares a host with the named mount's
      public upstream. Écluse's own mirror-write credential would reach a public registry.
      -}
      MirrorTargetOnPublicUpstream Ecosystem Ecosystem Text
    | {- | A mount's mirror target is also the named mount's endpoint under the named key, at the
      carried registry. A sweep of that store would delete data the other role owns.
      -}
      MirrorTargetOnMountEndpoint Ecosystem Ecosystem Text Text
    | -- | One repository receives caller credentials and bypasses the public rules through the private leg.
      PrivateUpstreamOnPublicUpstream Ecosystem Text
    | {- | The mount's private upstream can serve public content, so every version it holds would
      be trusted as private. Carries what the backend reported.
      -}
      PrivateUpstreamUnsafe Ecosystem UnsafeReason
    | {- | Asking the mount's private upstream what it aggregates threw rather than answering, so
      nothing was settled about it. Carries the rendered exception.
      -}
      PrivateUpstreamProbeFailed Ecosystem Text
    | {- | Two endpoints, each carried as its mount and its tagged key path, name the carried
      registry under different tags, so the two declarations disagree about what serves that store.
      -}
      StoreTagConflict Ecosystem Text Ecosystem Text Text
    | {- | An explicit memory override breaks the combined memory-plan invariant even after every
      tenant shed to its minimum. A computed plan degrades and boots, an operator claim does not.
      -}
      MemoryPlanOverrideUnsafe [Text]
    | {- | A split-deployment role (carried as its invocation) was selected over the bounded
      in-memory queue, whose jobs never leave the process that enqueued them.
      -}
      SplitRoleNeedsDurableQueue Text
    | {- | The dedicated mirror worker was launched with no mount declaring a mirror target, so
      it has no queue to drain and nothing to publish.
      -}
      MirrorRoleWithoutMirroring
    | {- | Building the configured mirror-queue backend threw. Carries the rendered exception,
      which tells a transient fault from a permanent one to fix.
      -}
      MirrorQueueUnavailable Text
    | {- | Preparing the configured advisory sync threw. Carries the rendered exception, which
      tells a transient fault from a permanent one to fix.
      -}
      AdvisorySyncUnavailable Text
    | {- | A vetted mirror store has no store maintenance backend the Dredger can sweep it
      with, carrying why.
      -}
      StoreMaintenanceUnavailable Ecosystem StoreMaintenanceReason
    | {- | Two @dredger.quotaOverrides@ entries declare the same capacity pool differently,
      carried as the pool and the two keys that define it.
      -}
      DredgerQuotaScopeConflict Text Text Text
    | {- | The configured pause between sweep chunks is beneath its floor, carried beside it.
      Only the deleting role reads the @dredger@ group, so only that role refuses.
      -}
      DredgerChunkPauseBeneathFloor NominalDiffTime NominalDiffTime
    | {- | A mount's rules deny on the advisory database and no advisory store is configured, so
      those rules could never decide. Carries the mount and the rule names, in policy order.
      -}
      AdvisoryDenyWithoutStore Ecosystem (NonEmpty Text)
    | {- | An advisory store is configured and no mount is, so @ecluse pilot@ has no ecosystem
      to compile an artifact for and would publish nothing.
      -}
      PilotWithoutEcosystem
    | -- | The progress window is zero or negative. Carries the configured seconds.
      ProgressWindowNotPositive Int
    | {- | The progress window is not below the serve-path cap, so the floor could never fire
      first on a served request. Carries the window and the cap, in seconds.
      -}
      ProgressWindowNotBelowServeCap Int Int
    | -- | The progress floor's byte count is zero or negative. Carries the configured count.
      MinProgressBytesNotPositive Int
    deriving stock (BootError -> BootError -> Bool
(BootError -> BootError -> Bool)
-> (BootError -> BootError -> Bool) -> Eq BootError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BootError -> BootError -> Bool
== :: BootError -> BootError -> Bool
$c/= :: BootError -> BootError -> Bool
/= :: BootError -> BootError -> Bool
Eq, Int -> BootError -> ShowS
[BootError] -> ShowS
BootError -> String
(Int -> BootError -> ShowS)
-> (BootError -> String)
-> ([BootError] -> ShowS)
-> Show BootError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BootError -> ShowS
showsPrec :: Int -> BootError -> ShowS
$cshow :: BootError -> String
show :: BootError -> String
$cshowList :: [BootError] -> ShowS
showList :: [BootError] -> ShowS
Show)

-- | Why a mount's mirror target reached no store maintenance handle.
data StoreMaintenanceReason
    = -- | The mount's store tag names no control plane this build implements.
      NoControlPlane StoreTag
    | -- | The mount's store carries no operator consent to delete from it.
      DeletionNotPermitted StoreTag
    | {- | The store's only control plane is the ecosystem protocol, which spells no package
      listing or version delete.
      -}
      NoProtocolMaintenance
    | -- | The declared private cache lacks a supported maintenance or authentication operation.
      PrivateCacheUnavailable Text
    | -- | Building the cleared backend's client against the live environment threw.
      ClientBuildFailed Text
    deriving stock (StoreMaintenanceReason -> StoreMaintenanceReason -> Bool
(StoreMaintenanceReason -> StoreMaintenanceReason -> Bool)
-> (StoreMaintenanceReason -> StoreMaintenanceReason -> Bool)
-> Eq StoreMaintenanceReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreMaintenanceReason -> StoreMaintenanceReason -> Bool
== :: StoreMaintenanceReason -> StoreMaintenanceReason -> Bool
$c/= :: StoreMaintenanceReason -> StoreMaintenanceReason -> Bool
/= :: StoreMaintenanceReason -> StoreMaintenanceReason -> Bool
Eq, Int -> StoreMaintenanceReason -> ShowS
[StoreMaintenanceReason] -> ShowS
StoreMaintenanceReason -> String
(Int -> StoreMaintenanceReason -> ShowS)
-> (StoreMaintenanceReason -> String)
-> ([StoreMaintenanceReason] -> ShowS)
-> Show StoreMaintenanceReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreMaintenanceReason -> ShowS
showsPrec :: Int -> StoreMaintenanceReason -> ShowS
$cshow :: StoreMaintenanceReason -> String
show :: StoreMaintenanceReason -> String
$cshowList :: [StoreMaintenanceReason] -> ShowS
showList :: [StoreMaintenanceReason] -> ShowS
Show)

{- | A finding a role boots on and warns about. The deleting role refuses the collapses below,
so no advisory naming one reaches it.
-}
data Advisory
    = {- | A mount's mirror target is also the named mount's private upstream, at the carried
      registry. Both mounts are carried, because the two can differ.
      -}
      MirrorTargetOnPrivateUpstream Ecosystem Ecosystem RegistryUrl
    | -- | A mount's mirror target is also its own publication target, at the carried registry.
      MirrorTargetOnOwnPublicationTarget Ecosystem RegistryUrl
    | {- | A @dredger.quotaOverrides@ entry names a store no mount declares, carried as the key it
      was written under.
      -}
      DredgerQuotaOverrideUnmatched Text
    | {- | Whether the mount's private upstream serves public content stayed open, so that
      topology stays the operator's to verify. Carries why it stayed open.
      -}
      PrivateUpstreamUndecided Ecosystem UndecidabilityReason
    deriving stock (Advisory -> Advisory -> Bool
(Advisory -> Advisory -> Bool)
-> (Advisory -> Advisory -> Bool) -> Eq Advisory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Advisory -> Advisory -> Bool
== :: Advisory -> Advisory -> Bool
$c/= :: Advisory -> Advisory -> Bool
/= :: Advisory -> Advisory -> Bool
Eq, Int -> Advisory -> ShowS
[Advisory] -> ShowS
Advisory -> String
(Int -> Advisory -> ShowS)
-> (Advisory -> String) -> ([Advisory] -> ShowS) -> Show Advisory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Advisory -> ShowS
showsPrec :: Int -> Advisory -> ShowS
$cshow :: Advisory -> String
show :: Advisory -> String
$cshowList :: [Advisory] -> ShowS
showList :: [Advisory] -> ShowS
Show)

{- | Fold a thrown fault into the boot error the caller names, so a phase that dials a live
environment refuses through the aggregate rather than escaping the boot as an exception.
-}
refuseOnThrow :: (Text -> BootError) -> IO a -> IO (Either [BootError] a)
refuseOnThrow :: forall a. (Text -> BootError) -> IO a -> IO (Either [BootError] a)
refuseOnThrow Text -> BootError
refusal IO a
action = (SomeException -> [BootError])
-> Either SomeException a -> Either [BootError] a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (BootError -> [BootError]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BootError -> [BootError])
-> (SomeException -> BootError) -> SomeException -> [BootError]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> BootError
refusal (Text -> BootError)
-> (SomeException -> Text) -> SomeException -> BootError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Text
forall e. Exception e => e -> Text
displayExceptionT) (Either SomeException a -> Either [BootError] a)
-> IO (Either SomeException a) -> IO (Either [BootError] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny IO a
action

{- | Render an aggregated refusal as the one block a failed launch reports, so every problem an
operator must fix appears in a single run.
-}
renderBootErrors :: [BootError] -> Text
renderBootErrors :: [BootError] -> Text
renderBootErrors = [Text] -> Text
T.unlines ([Text] -> Text) -> ([BootError] -> [Text]) -> [BootError] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BootError -> Text) -> [BootError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map BootError -> Text
renderBootError

-- | Render a 'BootError' as a human-facing line for the aggregated failure block.
renderBootError :: BootError -> Text
renderBootError :: BootError -> Text
renderBootError = \case
    PolicyBootError PolicyError
err -> PolicyError -> Text
renderPolicyError PolicyError
err
    MissingAdapter Ecosystem
eco ->
        Text
"mount " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no adapter wired in this build"
    UnresolvedCredential Ecosystem
eco ->
        Text
"mount "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no initialised mirror-write credential in this build"
    QueueProviderUnavailable Text
provider ->
        Text
"mirror queue provider "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
provider
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (named by the ECLUSE_QUEUE__URL shape) is not available in this build"
    BootError
QueueRegionMissing ->
        Text
"the SQS endpoint override (AWS_ENDPOINT_URL_SQS) is set but AWS_REGION is not: an emulator or VPC endpoint does not carry its region, so AWS_REGION must scope it"
    QueueUrlUnrecognised Text
url ->
        Text
"ECLUSE_QUEUE__URL names no queue backend this build knows: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (expected an SQS queue URL, https://sqs.{region}.amazonaws.com/{account}/{queue}, or a Pub/Sub topic resource, projects/{project}/topics/{topic}; unset it to run the bounded in-memory queue)"
    -- Both endpoint values can carry a credential, so each reason names its variable,
    -- never the URL.
    QueueEndpointMalformed{} ->
        Text
"the SQS endpoint override (AWS_ENDPOINT_URL_SQS) is not a valid endpoint URL"
    AwsEndpointMalformed{} ->
        Text
"the AWS endpoint override (AWS_ENDPOINT_URL) is not a valid endpoint URL"
    CodeArtifactMintFailed NonEmpty Text
targets Text
detail ->
        Text
"credential provider codeartifact for "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
targets)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed to mint an initial token at boot: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (a transient AWS error may clear on retry. A permanent one, such as a bad domain or region or a missing permission, must be fixed)"
    MirrorTargetWithoutPublish Ecosystem
eco ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"mirrorTarget"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is set but this build writes nothing for the "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" protocol: the mirror would drain its queue with no way to publish, so the mount is refused rather than served with a mirror that fails every job."
    PublicationTargetWithoutPublish Ecosystem
eco ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"publicationTarget"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is set but this build writes nothing for the "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" protocol: a publish would have no adapter to relay through, so the mount is refused rather than served with a publish route that refuses every attempt."
    FirstPartyMissing Ecosystem
eco ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"publicationTarget" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is set but " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"firstParty" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not: a publication target needs the namespaces this deployment owns, written in the ecosystem's own shape (npm scopes such as @acme, PyPI distribution names and acme-* prefixes), for the anti-shadowing guard."
    FirstPartyWithoutPrivateUpstream Ecosystem
eco ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"firstParty"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is set but "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"privateUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not: first-party names resolve from the private upstream alone. Configure privateUpstream for these names, or remove firstParty."
    PublishStaticCredentialNeedsEdge Ecosystem
eco StoreTag
tag ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco (Text
"publicationTarget." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StoreTag -> Text
storeTagName StoreTag
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".token")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is set but ECLUSE_SERVER__AUTH_TOKEN is not: a static publish credential needs a verifiable inbound edge."
    PublicationTargetOnPublicUpstream Ecosystem
eco Ecosystem
other Text
url ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"publicationTarget"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") shares a host with "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
other Text
"publicUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": a publish carries the publisher's own credential, which must never reach a public upstream, so point it at a registry that shares a host with no public upstream"
    PublicationTargetOnMountEndpoint Ecosystem
eco Ecosystem
other Text
key Text
url ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"publicationTarget"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is also "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
other Text
key
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): point it at a registry that holds no other role, so a publish is never relayed into one"
    MirrorTargetOnPublicUpstream Ecosystem
eco Ecosystem
other Text
url ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"mirrorTarget"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") shares a host with "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
other Text
"publicUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": the mirror write carries this proxy's own credential, which must never reach a public upstream, so point it at a registry that shares a host with no public upstream"
    MirrorTargetOnMountEndpoint Ecosystem
eco Ecosystem
other Text
key Text
url ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"mirrorTarget"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is also "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
other Text
key
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): the Dredger permanently deletes from the mirror target, so point it at a registry that holds no other role, or run no Dredger against this configuration"
    PrivateUpstreamOnPublicUpstream Ecosystem
eco Text
url ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"privateUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"publicUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" resolve to the same registry ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): the private leg forwards caller credentials and admits versions without the public rules. Configure distinct repositories."
    PrivateUpstreamUnsafe Ecosystem
eco (ConfigurationEvidence RepositoryName
repository ExternalConnection
connection) ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"privateUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" admits public content: repository "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RepositoryName -> Text
repositoryNameText RepositoryName
repository
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" carries the external connection "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExternalConnection -> Text
externalConnectionText ExternalConnection
connection
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", so public packages reach clients as trusted private content, past the public rules, the integrity floor and the quarantine. Remove that connection from the repository and its upstream chain, or point privateUpstream at a repository that has none"
    PrivateUpstreamUnsafe Ecosystem
eco (InsufficientPermissions PermissionName
permission) ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"privateUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" could not be read: this role's identity is refused "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PermissionName -> Text
permissionNameText PermissionName
permission
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on that repository or one in its upstream chain. Or this role resolved no identity at all. An identity that cannot ask cannot clear the repository, so give this role an AWS identity carrying that grant, or point privateUpstream at a repository this role may read"
    PrivateUpstreamProbeFailed Ecosystem
eco Text
detail ->
        Text
"the check for a connection to a public registry on "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"privateUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" threw: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
    StoreTagConflict Ecosystem
eco Text
key Ecosystem
other Text
otherKey Text
url ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
key
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
other Text
otherKey
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" name the same registry ("
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") under two tags: one store has one backend, so declare both endpoints under the same tag"
    MemoryPlanOverrideUnsafe [Text]
details ->
        Text
"memory plan refused: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"; " [Text]
details
    SplitRoleNeedsDurableQueue Text
invocation ->
        Text
invocation
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" splits the mirror worker from the proxy, but ECLUSE_QUEUE__URL is unset, so mirroring runs on the bounded in-memory queue whose jobs never leave the process that enqueued them: point ECLUSE_QUEUE__URL at a durable queue, or run the single-process ecluse proxy"
    BootError
MirrorRoleWithoutMirroring ->
        Text
"ecluse mirror runs the mirror worker alone, but no mount declares a mirror target, so it has nothing to mirror: set ECLUSE_MOUNTS__<ECOSYSTEM>__MIRROR_TARGET__<TAG>__URL, or run a role that needs no mirror queue"
    MirrorQueueUnavailable Text
detail ->
        Text
"the mirror queue backend named by ECLUSE_QUEUE__URL could not be built at boot: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (a transient AWS or network error may clear on retry. A permanent one, such as unresolvable AWS credentials or a queue URL naming no reachable queue, must be fixed)"
    AdvisorySyncUnavailable Text
detail ->
        Text
"the advisory sync named by ECLUSE_ADVISORIES__URL could not be prepared at boot: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (a transient AWS or network error may clear on retry. A permanent one, such as unresolvable AWS credentials or an ECLUSE_ADVISORIES__DATA_DIR this process cannot create, must be fixed)"
    StoreMaintenanceUnavailable Ecosystem
eco (PrivateCacheUnavailable Text
detail) ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"privateUpstream" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no usable observation backend: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
    StoreMaintenanceUnavailable Ecosystem
eco StoreMaintenanceReason
reason ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"mirrorTarget"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no usable store maintenance backend: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> StoreMaintenanceReason -> Text
renderStoreMaintenanceReason Ecosystem
eco StoreMaintenanceReason
reason
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (the Dredger deletes from every mount's mirror target, so it refuses rather than starting against a store it cannot sweep)"
    DredgerQuotaScopeConflict Text
scope Text
oneKey Text
otherKey ->
        Text
"dredger.quotaOverrides: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
authorityLabel Text
oneKey
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
authorityLabel Text
otherKey
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" both define the capacity pool \""
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
scopeLabel Text
scope
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" and define it differently: one pool takes one definition, so give the two entries the same quotas and weights or separate scopes"
    DredgerChunkPauseBeneathFloor NominalDiffTime
configured NominalDiffTime
floorPause ->
        Text
"ECLUSE_DREDGER__CHUNK_PAUSE (dredger.chunkPause) is "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
configured
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", beneath the floor of "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
floorPause
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": the pause between chunks is what leaves time to stop a mistaken sweep. Deletion is permanent, so the pause may be raised and never lowered"
    AdvisoryDenyWithoutStore Ecosystem
eco NonEmpty Text
rules ->
        Text
"mount \""
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" enables the advisory deny rules "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Text
rules)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but ECLUSE_ADVISORIES__URL (advisories.url) is unset: those rules have no advisory database to read, so every version they evaluate would refuse. Set the advisory store and run ecluse pilot to publish an artifact for this mount, or remove these rules from its policy"
    BootError
PilotWithoutEcosystem ->
        Text
"ECLUSE_ADVISORIES__URL is set but no mount is declared, so ecluse pilot has no ecosystem to compile an advisory artifact for: declare the mounts this deployment serves under ECLUSE_MOUNTS__<ECOSYSTEM>__, or run a role this configuration has work for"
    ProgressWindowNotPositive Int
configured ->
        Text
"ECLUSE_LIMITS__PROGRESS_WINDOW (limits.progressWindow) is "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
configured
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": the window within which an upstream must deliver its minimum bytes must be a positive number of seconds"
    ProgressWindowNotBelowServeCap Int
configured Int
cap ->
        Text
"ECLUSE_LIMITS__PROGRESS_WINDOW (limits.progressWindow) is "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
configured
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", not below the "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
cap
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-second cap on each upstream exchange of a served request: a slow upstream must fail the floor before the cap ends it, so set it below "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
cap
    MinProgressBytesNotPositive Int
configured ->
        Text
"ECLUSE_LIMITS__MIN_PROGRESS_BYTES (limits.minProgressBytes) is "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
configured
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": the bytes an upstream must deliver in each progress window must be a positive count"

renderStoreMaintenanceReason :: Ecosystem -> StoreMaintenanceReason -> Text
renderStoreMaintenanceReason :: Ecosystem -> StoreMaintenanceReason -> Text
renderStoreMaintenanceReason Ecosystem
eco = \case
    NoControlPlane StoreTag
tag ->
        Text
"its target is a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StoreTag -> Text
storeTagName StoreTag
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" store, which carries no store maintenance backend this build can sweep"
    DeletionNotPermitted StoreTag
tag ->
        Text
"its target is a "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StoreTag -> Text
storeTagName StoreTag
tag
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" store and "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco (Text
"mirrorTarget." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StoreTag -> Text
storeTagName StoreTag
tag Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".permitDeletion")
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not set: that key is your consent for the Dredger to delete from this store"
    StoreMaintenanceReason
NoProtocolMaintenance ->
        Text
"its store has no control plane, and the "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" protocol carries no package listing or version delete for one"
    PrivateCacheUnavailable Text
detail -> Text
"privateUpstream cannot be previewed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail
    ClientBuildFailed Text
detail -> Text
"building its client failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail

{- | Render an advisory as the warning line a boot logs and @ecluse check-config@ prints. Both
entry points render here, so neither can word a warning its own way.
-}
renderAdvisory :: Advisory -> Text
renderAdvisory :: Advisory -> Text
renderAdvisory = \case
    MirrorTargetOnPrivateUpstream Ecosystem
eco Ecosystem
other RegistryUrl
url ->
        Ecosystem -> Text -> RegistryUrl -> Text
mirrorCollapseLine Ecosystem
eco (Ecosystem -> Ecosystem -> Text -> Text
endpointRef Ecosystem
eco Ecosystem
other Text
"privateUpstream") RegistryUrl
url
    MirrorTargetOnOwnPublicationTarget Ecosystem
eco RegistryUrl
url ->
        Ecosystem -> Text -> RegistryUrl -> Text
mirrorCollapseLine Ecosystem
eco Text
"publicationTarget" RegistryUrl
url
    DredgerQuotaOverrideUnmatched Text
key ->
        Text
"dredger.quotaOverrides: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
authorityLabel Text
key
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" names no store this deployment declares, so it paces nothing"
    PrivateUpstreamUndecided Ecosystem
eco UndecidabilityReason
reason ->
        Ecosystem -> Text -> Text
mountKeyRef Ecosystem
eco Text
"privateUpstream"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was not checked for a connection to a public registry: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UndecidabilityReason -> Text
renderUndecidability UndecidabilityReason
reason
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". A repository that aggregates a public registry serves public packages as trusted private content, so confirming that this one does not stays yours"

-- Why the backend settled nothing, in the words an operator acts on.
renderUndecidability :: UndecidabilityReason -> Text
renderUndecidability :: UndecidabilityReason -> Text
renderUndecidability = \case
    UndecidabilityReason
NoMechanism -> Text
"its backend does not report the repositories and registries it aggregates"
    UndecidabilityReason
NetworkFailure -> Text
"its backend did not answer"
    UndecidabilityReason
ChainBoundExceeded -> Text
"its upstream chain crossed this walk's bounds before it was read whole"

-- The line both mirror collapses take: the collapsed pair, the registry they share, and the
-- consequence of keeping the configuration.
mirrorCollapseLine :: Ecosystem -> Text -> RegistryUrl -> Text
mirrorCollapseLine :: Ecosystem -> Text -> RegistryUrl -> Text
mirrorCollapseLine Ecosystem
eco Text
otherRef RegistryUrl
url =
    Text
"mount \""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
eco
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\": mirrorTarget and "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
otherRef
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" resolve to the same registry ("
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RegistryUrl -> Text
registryUrlText RegistryUrl
url
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"); the Dredger refuses this configuration, so pruning this mirror stays manual"

{- A pool as a line names it: the operator's own label, reduced to its authority where they spelled
a URL, so a credential written into a scope never reaches a log line. -}
scopeLabel :: Text -> Text
scopeLabel :: Text -> Text
scopeLabel Text
raw
    | Text
"://" Text -> Text -> Bool
`T.isInfixOf` Text
raw = Text -> Text
authorityLabel Text
raw
    | Bool
otherwise = Text
raw

-- A neighbouring mount's endpoint is named by its mount. The subject's own is not.
endpointRef :: Ecosystem -> Ecosystem -> Text -> Text
endpointRef :: Ecosystem -> Ecosystem -> Text -> Text
endpointRef Ecosystem
eco Ecosystem
other Text
key
    | Ecosystem
eco Ecosystem -> Ecosystem -> Bool
forall a. Eq a => a -> a -> Bool
== Ecosystem
other = Text
key
    | Bool
otherwise = Text
"mount \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
ecosystemName Ecosystem
other Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key