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

{- | The decisions Pilot makes before it does anything: whether the scheduled loop exports at
all and how often, which upstreams one compile reads, whether a failed EPSS feed stops its
publication, and whether a one-shot run uploads.

Each is a pure function over the resolved configuration, so "Ecluse.Pilot" dispatches on their
results instead of branching inside @IO@ ("Ecluse.Composition.MirrorRole" is the same shape).
-}
module Ecluse.Pilot.Plan (
    -- * The scheduled export loop
    ExportLoopPlan (..),
    ExportTarget (..),
    exportLoopPlan,
    exportCadenceMicros,
    idleCadenceMicros,

    -- * The upstreams a compile reads
    configuredSources,
    quietTimeFor,
    epssAttemptLine,

    -- * The one-shot run
    PilotCompileOptions (..),
    compileEpssRequirement,
    unmountedCompileWarning,
    UploadPlan (..),
    uploadPlan,
    PilotUploadUnconfigured (..),
    uploadTarget,
) where

import Data.Map.Strict qualified as Map
import System.FilePath (takeFileName)

import Ecluse.Config (
    AdvisoriesSettings (advCompileInterval, advEpssFeedUrl, advEpssQuietTime, advOsvExportBaseUrl, advQuietTime, advUrl),
    AdvisoryStoreUrl,
    Mount,
    MountMap,
    advisoryObjectKey,
    advisoryStoreBucket,
    mountEpssRequirement,
    unUrl,
 )
import Ecluse.Core.Clock (secondsToMicros)
import Ecluse.Core.Ecosystem (Ecosystem, parseEcosystem)
import Ecluse.Core.Osv.Advisory (osvExportUrl)
import Ecluse.Core.Osv.Compile (CompileSources (..))
import Ecluse.Core.Osv.Ecosystem (OsvEcosystem (osvExportDirectory))
import Ecluse.Core.Osv.Provenance (QuietTime (..), defaultQuietTime)
import Ecluse.Core.Osv.Schema (EpssRequirement (EpssRequired))
import Ecluse.Core.Security.Authority (dialledAuthorityLabel)

-- | What the scheduled export loop does with the advisory settings and the mounted ecosystems.
data ExportLoopPlan
    = -- | No advisory store is configured, so the loop idles and exports nothing.
      ExportIdle
    | -- | Compile and upload one artifact per target to this store, each on its own cadence.
      ExportTo AdvisoryStoreUrl (NonEmpty ExportTarget)
    deriving stock (ExportLoopPlan -> ExportLoopPlan -> Bool
(ExportLoopPlan -> ExportLoopPlan -> Bool)
-> (ExportLoopPlan -> ExportLoopPlan -> Bool) -> Eq ExportLoopPlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExportLoopPlan -> ExportLoopPlan -> Bool
== :: ExportLoopPlan -> ExportLoopPlan -> Bool
$c/= :: ExportLoopPlan -> ExportLoopPlan -> Bool
/= :: ExportLoopPlan -> ExportLoopPlan -> Bool
Eq, Int -> ExportLoopPlan -> ShowS
[ExportLoopPlan] -> ShowS
ExportLoopPlan -> String
(Int -> ExportLoopPlan -> ShowS)
-> (ExportLoopPlan -> String)
-> ([ExportLoopPlan] -> ShowS)
-> Show ExportLoopPlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExportLoopPlan -> ShowS
showsPrec :: Int -> ExportLoopPlan -> ShowS
$cshow :: ExportLoopPlan -> String
show :: ExportLoopPlan -> String
$cshowList :: [ExportLoopPlan] -> ShowS
showList :: [ExportLoopPlan] -> ShowS
Show)

-- | One mounted ecosystem the scheduled loop compiles, with what a failed EPSS feed means for it.
data ExportTarget = ExportTarget
    { ExportTarget -> Ecosystem
etEcosystem :: Ecosystem
    , ExportTarget -> EpssRequirement
etEpss :: EpssRequirement
    -- ^ The mount's resolved requirement, the one its advisory consumers enforce.
    }
    deriving stock (ExportTarget -> ExportTarget -> Bool
(ExportTarget -> ExportTarget -> Bool)
-> (ExportTarget -> ExportTarget -> Bool) -> Eq ExportTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExportTarget -> ExportTarget -> Bool
== :: ExportTarget -> ExportTarget -> Bool
$c/= :: ExportTarget -> ExportTarget -> Bool
/= :: ExportTarget -> ExportTarget -> Bool
Eq, Int -> ExportTarget -> ShowS
[ExportTarget] -> ShowS
ExportTarget -> String
(Int -> ExportTarget -> ShowS)
-> (ExportTarget -> String)
-> ([ExportTarget] -> ShowS)
-> Show ExportTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExportTarget -> ShowS
showsPrec :: Int -> ExportTarget -> ShowS
$cshow :: ExportTarget -> String
show :: ExportTarget -> String
$cshowList :: [ExportTarget] -> ShowS
showList :: [ExportTarget] -> ShowS
Show)

{- | A configured store turns exporting on, as it does for the proxy's sync, and each mounted
ecosystem earns an artifact. 'Nothing' is a store with no ecosystem to compile, which the boot refuses.
-}
exportLoopPlan :: AdvisoriesSettings -> [ExportTarget] -> Maybe ExportLoopPlan
exportLoopPlan :: AdvisoriesSettings -> [ExportTarget] -> Maybe ExportLoopPlan
exportLoopPlan AdvisoriesSettings
advisories [ExportTarget]
targets = case AdvisoriesSettings -> Maybe AdvisoryStoreUrl
advUrl AdvisoriesSettings
advisories of
    Maybe AdvisoryStoreUrl
Nothing -> ExportLoopPlan -> Maybe ExportLoopPlan
forall a. a -> Maybe a
Just ExportLoopPlan
ExportIdle
    Just AdvisoryStoreUrl
store -> AdvisoryStoreUrl -> NonEmpty ExportTarget -> ExportLoopPlan
ExportTo AdvisoryStoreUrl
store (NonEmpty ExportTarget -> ExportLoopPlan)
-> Maybe (NonEmpty ExportTarget) -> Maybe ExportLoopPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExportTarget] -> Maybe (NonEmpty ExportTarget)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [ExportTarget]
targets

{- | The delay between export cycles. The config decoder bounds @compileInterval@ to
@maxBound \`div\` 1000000@ seconds, so this conversion cannot wrap to a negative delay.
-}
exportCadenceMicros :: AdvisoriesSettings -> Int
exportCadenceMicros :: AdvisoriesSettings -> Int
exportCadenceMicros = NominalDiffTime -> Int
secondsToMicros (NominalDiffTime -> Int)
-> (AdvisoriesSettings -> NominalDiffTime)
-> AdvisoriesSettings
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdvisoriesSettings -> NominalDiffTime
advCompileInterval

{- | How long the idle loop sleeps between wakeups. Nothing observes the wakeup, because an
added store only takes effect on the next boot, so the sleep is deliberately long.
-}
idleCadenceMicros :: Int
idleCadenceMicros :: Int
idleCadenceMicros = NominalDiffTime -> Int
secondsToMicros (NominalDiffTime
24 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60)

{- | The upstreams a compile reads, scheduled or one-shot. Both are configured keys, so a moved or
mirrored feed never needs a new binary.
-}
configuredSources :: AdvisoriesSettings -> OsvEcosystem -> CompileSources
configuredSources :: AdvisoriesSettings -> OsvEcosystem -> CompileSources
configuredSources AdvisoriesSettings
advisories OsvEcosystem
eco =
    CompileSources
        { csOsvExportUrl :: String
csOsvExportUrl = Text -> Text -> String
osvExportUrl (Url -> Text
unUrl (AdvisoriesSettings -> Url
advOsvExportBaseUrl AdvisoriesSettings
advisories)) (OsvEcosystem -> Text
osvExportDirectory OsvEcosystem
eco)
        , csEpssFeedUrl :: String
csEpssFeedUrl = Text -> String
forall a. ToString a => a -> String
toString (Url -> Text
unUrl (AdvisoriesSettings -> Url
advEpssFeedUrl AdvisoriesSettings
advisories))
        }

-- | The egress every compile attempts whatever the rules, named by the host and port it dials.
epssAttemptLine :: AdvisoriesSettings -> Text
epssAttemptLine :: AdvisoriesSettings -> Text
epssAttemptLine AdvisoriesSettings
advisories =
    Text
"pilot: every compile attempts the EPSS feed at "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
dialledAuthorityLabel (Url -> Text
unUrl (AdvisoriesSettings -> Url
advEpssFeedUrl AdvisoriesSettings
advisories))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", whatever the rules, so its egress must be allowed"

{- | The quiet-time thresholds one compile is judged against. An ecosystem with no configured
threshold, and a one-shot compile of a name this build does not serve, take 'defaultQuietTime'.
-}
quietTimeFor :: AdvisoriesSettings -> Maybe Ecosystem -> QuietTime
quietTimeFor :: AdvisoriesSettings -> Maybe Ecosystem -> QuietTime
quietTimeFor AdvisoriesSettings
advisories Maybe Ecosystem
mEco =
    QuietTime
        { qtOsv :: NominalDiffTime
qtOsv = NominalDiffTime
-> (Ecosystem -> NominalDiffTime)
-> Maybe Ecosystem
-> NominalDiffTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NominalDiffTime
defaultQuietTime Ecosystem -> NominalDiffTime
configured Maybe Ecosystem
mEco
        , qtEpss :: NominalDiffTime
qtEpss = AdvisoriesSettings -> NominalDiffTime
advEpssQuietTime AdvisoriesSettings
advisories
        }
  where
    configured :: Ecosystem -> NominalDiffTime
configured Ecosystem
eco = NominalDiffTime
-> Ecosystem -> Map Ecosystem NominalDiffTime -> NominalDiffTime
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault NominalDiffTime
defaultQuietTime Ecosystem
eco (AdvisoriesSettings -> Map Ecosystem NominalDiffTime
advQuietTime AdvisoriesSettings
advisories)

-- | Options for the one-shot @ecluse pilot compile@ mode.
data PilotCompileOptions = PilotCompileOptions
    { PilotCompileOptions -> Text
pcoEcosystem :: Text
    , PilotCompileOptions -> String
pcoOutDir :: FilePath
    , PilotCompileOptions -> Bool
pcoUpload :: Bool
    -- ^ Upload the compiled artifact to the configured advisory store.
    }
    deriving stock (PilotCompileOptions -> PilotCompileOptions -> Bool
(PilotCompileOptions -> PilotCompileOptions -> Bool)
-> (PilotCompileOptions -> PilotCompileOptions -> Bool)
-> Eq PilotCompileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PilotCompileOptions -> PilotCompileOptions -> Bool
== :: PilotCompileOptions -> PilotCompileOptions -> Bool
$c/= :: PilotCompileOptions -> PilotCompileOptions -> Bool
/= :: PilotCompileOptions -> PilotCompileOptions -> Bool
Eq, Int -> PilotCompileOptions -> ShowS
[PilotCompileOptions] -> ShowS
PilotCompileOptions -> String
(Int -> PilotCompileOptions -> ShowS)
-> (PilotCompileOptions -> String)
-> ([PilotCompileOptions] -> ShowS)
-> Show PilotCompileOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PilotCompileOptions -> ShowS
showsPrec :: Int -> PilotCompileOptions -> ShowS
$cshow :: PilotCompileOptions -> String
show :: PilotCompileOptions -> String
$cshowList :: [PilotCompileOptions] -> ShowS
showList :: [PilotCompileOptions] -> ShowS
Show)

{- | The EPSS requirement a one-shot compile runs under. A mounted ecosystem takes its resolved
policy's. An unmounted one prepares a dataset ahead of its mount, so it requires the feed.
-}
compileEpssRequirement :: MountMap -> PilotCompileOptions -> EpssRequirement
compileEpssRequirement :: MountMap -> PilotCompileOptions -> EpssRequirement
compileEpssRequirement MountMap
mounts = EpssRequirement
-> (Mount -> EpssRequirement) -> Maybe Mount -> EpssRequirement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EpssRequirement
EpssRequired Mount -> EpssRequirement
mountEpssRequirement (Maybe Mount -> EpssRequirement)
-> (PilotCompileOptions -> Maybe Mount)
-> PilotCompileOptions
-> EpssRequirement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MountMap -> PilotCompileOptions -> Maybe Mount
compiledMount MountMap
mounts

-- | The warning a one-shot compile logs for an ecosystem the loaded configuration does not mount.
unmountedCompileWarning :: MountMap -> PilotCompileOptions -> Maybe Text
unmountedCompileWarning :: MountMap -> PilotCompileOptions -> Maybe Text
unmountedCompileWarning MountMap
mounts PilotCompileOptions
opts = case MountMap -> PilotCompileOptions -> Maybe Mount
compiledMount MountMap
mounts PilotCompileOptions
opts of
    Just Mount
_ -> Maybe Text
forall a. Maybe a
Nothing
    Maybe Mount
Nothing ->
        Text -> Maybe Text
forall a. a -> Maybe a
Just
            ( Text
"The loaded configuration mounts no "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PilotCompileOptions -> Text
pcoEcosystem PilotCompileOptions
opts
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ecosystem. This compile prepares its full dataset, so it requires EPSS enrichment and publishes nothing without it"
            )

compiledMount :: MountMap -> PilotCompileOptions -> Maybe Mount
compiledMount :: MountMap -> PilotCompileOptions -> Maybe Mount
compiledMount MountMap
mounts PilotCompileOptions
opts = (Ecosystem -> MountMap -> Maybe Mount
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` MountMap
mounts) (Ecosystem -> Maybe Mount) -> Maybe Ecosystem -> Maybe Mount
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe Ecosystem
parseEcosystem (PilotCompileOptions -> Text
pcoEcosystem PilotCompileOptions
opts)

{- | Requesting an upload without a configured advisory store. It is a wiring fault at the
composition root, so it throws rather than returning a value the caller could only re-raise.
-}
data PilotUploadUnconfigured = PilotUploadUnconfigured
    deriving stock (PilotUploadUnconfigured -> PilotUploadUnconfigured -> Bool
(PilotUploadUnconfigured -> PilotUploadUnconfigured -> Bool)
-> (PilotUploadUnconfigured -> PilotUploadUnconfigured -> Bool)
-> Eq PilotUploadUnconfigured
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PilotUploadUnconfigured -> PilotUploadUnconfigured -> Bool
== :: PilotUploadUnconfigured -> PilotUploadUnconfigured -> Bool
$c/= :: PilotUploadUnconfigured -> PilotUploadUnconfigured -> Bool
/= :: PilotUploadUnconfigured -> PilotUploadUnconfigured -> Bool
Eq, Int -> PilotUploadUnconfigured -> ShowS
[PilotUploadUnconfigured] -> ShowS
PilotUploadUnconfigured -> String
(Int -> PilotUploadUnconfigured -> ShowS)
-> (PilotUploadUnconfigured -> String)
-> ([PilotUploadUnconfigured] -> ShowS)
-> Show PilotUploadUnconfigured
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PilotUploadUnconfigured -> ShowS
showsPrec :: Int -> PilotUploadUnconfigured -> ShowS
$cshow :: PilotUploadUnconfigured -> String
show :: PilotUploadUnconfigured -> String
$cshowList :: [PilotUploadUnconfigured] -> ShowS
showList :: [PilotUploadUnconfigured] -> ShowS
Show)

instance Exception PilotUploadUnconfigured

-- | Whether a one-shot run uploads its artifact, and where.
data UploadPlan
    = -- | The run did not ask to upload, so the artifact stays local.
      UploadSkipped
    | -- | Upload the compiled artifact to this store.
      UploadTo AdvisoryStoreUrl
    deriving stock (UploadPlan -> UploadPlan -> Bool
(UploadPlan -> UploadPlan -> Bool)
-> (UploadPlan -> UploadPlan -> Bool) -> Eq UploadPlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UploadPlan -> UploadPlan -> Bool
== :: UploadPlan -> UploadPlan -> Bool
$c/= :: UploadPlan -> UploadPlan -> Bool
/= :: UploadPlan -> UploadPlan -> Bool
Eq, Int -> UploadPlan -> ShowS
[UploadPlan] -> ShowS
UploadPlan -> String
(Int -> UploadPlan -> ShowS)
-> (UploadPlan -> String)
-> ([UploadPlan] -> ShowS)
-> Show UploadPlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UploadPlan -> ShowS
showsPrec :: Int -> UploadPlan -> ShowS
$cshow :: UploadPlan -> String
show :: UploadPlan -> String
$cshowList :: [UploadPlan] -> ShowS
showList :: [UploadPlan] -> ShowS
Show)

{- | Plan a one-shot run's upload. Asking for one with no store configured is refused, never
skipped, so a scripted run cannot exit successfully having published nothing.
-}
uploadPlan :: PilotCompileOptions -> Maybe AdvisoryStoreUrl -> Either PilotUploadUnconfigured UploadPlan
uploadPlan :: PilotCompileOptions
-> Maybe AdvisoryStoreUrl
-> Either PilotUploadUnconfigured UploadPlan
uploadPlan PilotCompileOptions
opts Maybe AdvisoryStoreUrl
mStore
    | Bool -> Bool
not (PilotCompileOptions -> Bool
pcoUpload PilotCompileOptions
opts) = UploadPlan -> Either PilotUploadUnconfigured UploadPlan
forall a b. b -> Either a b
Right UploadPlan
UploadSkipped
    | Bool
otherwise = Either PilotUploadUnconfigured UploadPlan
-> (AdvisoryStoreUrl -> Either PilotUploadUnconfigured UploadPlan)
-> Maybe AdvisoryStoreUrl
-> Either PilotUploadUnconfigured UploadPlan
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PilotUploadUnconfigured
-> Either PilotUploadUnconfigured UploadPlan
forall a b. a -> Either a b
Left PilotUploadUnconfigured
PilotUploadUnconfigured) (UploadPlan -> Either PilotUploadUnconfigured UploadPlan
forall a b. b -> Either a b
Right (UploadPlan -> Either PilotUploadUnconfigured UploadPlan)
-> (AdvisoryStoreUrl -> UploadPlan)
-> AdvisoryStoreUrl
-> Either PilotUploadUnconfigured UploadPlan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdvisoryStoreUrl -> UploadPlan
UploadTo) Maybe AdvisoryStoreUrl
mStore

{- | Where one compiled artifact lands: the store's bucket, and the object key its own file
name takes under the store's prefix. The proxy's sync reads that same key.
-}
uploadTarget :: AdvisoryStoreUrl -> FilePath -> (Text, Text)
uploadTarget :: AdvisoryStoreUrl -> String -> (Text, Text)
uploadTarget AdvisoryStoreUrl
store String
dbPath =
    (AdvisoryStoreUrl -> Text
advisoryStoreBucket AdvisoryStoreUrl
store, AdvisoryStoreUrl -> String -> Text
advisoryObjectKey AdvisoryStoreUrl
store (ShowS
takeFileName String
dbPath))