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

{- | The advisory artifact contract shared by Pilot and its consumers.
The epoch covers incompatible table shapes and incompatible meanings of stored values.
Artifacts are rebuilt rather than migrated. Compatible additions preserve the epoch.
-}
module Ecluse.Core.Osv.Schema (
    -- * The artifact epoch
    osvSchemaEpoch,
    osvDbFileName,

    -- * The tables
    rangesTableDdl,
    metaTableDdl,
    ColumnSpec (..),
    TableSpec (..),
    osvTableSpecs,

    -- * The @meta@ table
    MetaKey (..),
    renderMetaKey,
    EpssRequirement (..),
    EpssStatus (..),
    renderEpssStatus,
    EpssEvidence (..),
    decodeEpssEvidence,
) where

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

-- | Advance for incompatible shape or stored-value semantics, not compatible additions.
osvSchemaEpoch :: Int
osvSchemaEpoch :: Int
osvSchemaEpoch = Int
4

-- | Keep a stable object key until the artifact's read contract changes.
osvDbFileName :: Text -> FilePath
osvDbFileName :: Text -> FilePath
osvDbFileName Text
ecosystem =
    Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
ecosystem FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-osv-schema" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall b a. (Show a, IsString b) => a -> b
show Int
osvSchemaEpoch FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".db"

-- | The ranges table's canonical strict DDL. The writer owns indexes outside this read contract.
rangesTableDdl :: Text
rangesTableDdl :: Text
rangesTableDdl =
    Text
"CREATE TABLE package_vulnerability_ranges (\
    \  package_name TEXT NOT NULL,\
    \  cve_id TEXT NOT NULL,\
    \  introduced_version TEXT,\
    \  fixed_version TEXT,\
    \  last_affected_version TEXT,\
    \  severity REAL,\
    \  epss_score REAL\
    \) STRICT"

-- | The @meta@ provenance table's canonical DDL, @STRICT@ like 'rangesTableDdl'.
metaTableDdl :: Text
metaTableDdl :: Text
metaTableDdl =
    Text
"CREATE TABLE meta (\
    \  key TEXT NOT NULL PRIMARY KEY,\
    \  value TEXT NOT NULL\
    \) STRICT"

-- | A required column's enforced storage type and nullability.
data ColumnSpec = ColumnSpec
    { ColumnSpec -> Text
colName :: Text
    , ColumnSpec -> Text
colDeclaredType :: Text
    , ColumnSpec -> Bool
colNotNull :: Bool
    }
    deriving stock (ColumnSpec -> ColumnSpec -> Bool
(ColumnSpec -> ColumnSpec -> Bool)
-> (ColumnSpec -> ColumnSpec -> Bool) -> Eq ColumnSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnSpec -> ColumnSpec -> Bool
== :: ColumnSpec -> ColumnSpec -> Bool
$c/= :: ColumnSpec -> ColumnSpec -> Bool
/= :: ColumnSpec -> ColumnSpec -> Bool
Eq, Int -> ColumnSpec -> FilePath -> FilePath
[ColumnSpec] -> FilePath -> FilePath
ColumnSpec -> FilePath
(Int -> ColumnSpec -> FilePath -> FilePath)
-> (ColumnSpec -> FilePath)
-> ([ColumnSpec] -> FilePath -> FilePath)
-> Show ColumnSpec
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ColumnSpec -> FilePath -> FilePath
showsPrec :: Int -> ColumnSpec -> FilePath -> FilePath
$cshow :: ColumnSpec -> FilePath
show :: ColumnSpec -> FilePath
$cshowList :: [ColumnSpec] -> FilePath -> FilePath
showList :: [ColumnSpec] -> FilePath -> FilePath
Show)

-- | A table the reader requires, with the columns its queries decode.
data TableSpec = TableSpec
    { TableSpec -> Text
tableName :: Text
    , TableSpec -> [ColumnSpec]
tableColumns :: [ColumnSpec]
    }
    deriving stock (TableSpec -> TableSpec -> Bool
(TableSpec -> TableSpec -> Bool)
-> (TableSpec -> TableSpec -> Bool) -> Eq TableSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableSpec -> TableSpec -> Bool
== :: TableSpec -> TableSpec -> Bool
$c/= :: TableSpec -> TableSpec -> Bool
/= :: TableSpec -> TableSpec -> Bool
Eq, Int -> TableSpec -> FilePath -> FilePath
[TableSpec] -> FilePath -> FilePath
TableSpec -> FilePath
(Int -> TableSpec -> FilePath -> FilePath)
-> (TableSpec -> FilePath)
-> ([TableSpec] -> FilePath -> FilePath)
-> Show TableSpec
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> TableSpec -> FilePath -> FilePath
showsPrec :: Int -> TableSpec -> FilePath -> FilePath
$cshow :: TableSpec -> FilePath
show :: TableSpec -> FilePath
$cshowList :: [TableSpec] -> FilePath -> FilePath
showList :: [TableSpec] -> FilePath -> FilePath
Show)

-- | Required strict tables and columns. Additional columns preserve reader compatibility.
osvTableSpecs :: [TableSpec]
osvTableSpecs :: [TableSpec]
osvTableSpecs =
    [ TableSpec
        { tableName :: Text
tableName = Text
"package_vulnerability_ranges"
        , tableColumns :: [ColumnSpec]
tableColumns =
            [ ColumnSpec{colName :: Text
colName = Text
"package_name", colDeclaredType :: Text
colDeclaredType = Text
"TEXT", colNotNull :: Bool
colNotNull = Bool
True}
            , ColumnSpec{colName :: Text
colName = Text
"cve_id", colDeclaredType :: Text
colDeclaredType = Text
"TEXT", colNotNull :: Bool
colNotNull = Bool
True}
            , ColumnSpec{colName :: Text
colName = Text
"introduced_version", colDeclaredType :: Text
colDeclaredType = Text
"TEXT", colNotNull :: Bool
colNotNull = Bool
False}
            , ColumnSpec{colName :: Text
colName = Text
"fixed_version", colDeclaredType :: Text
colDeclaredType = Text
"TEXT", colNotNull :: Bool
colNotNull = Bool
False}
            , ColumnSpec{colName :: Text
colName = Text
"last_affected_version", colDeclaredType :: Text
colDeclaredType = Text
"TEXT", colNotNull :: Bool
colNotNull = Bool
False}
            , ColumnSpec{colName :: Text
colName = Text
"severity", colDeclaredType :: Text
colDeclaredType = Text
"REAL", colNotNull :: Bool
colNotNull = Bool
False}
            , ColumnSpec{colName :: Text
colName = Text
"epss_score", colDeclaredType :: Text
colDeclaredType = Text
"REAL", colNotNull :: Bool
colNotNull = Bool
False}
            ]
        }
    , TableSpec
        { tableName :: Text
tableName = Text
"meta"
        , tableColumns :: [ColumnSpec]
tableColumns =
            [ ColumnSpec{colName :: Text
colName = Text
"key", colDeclaredType :: Text
colDeclaredType = Text
"TEXT", colNotNull :: Bool
colNotNull = Bool
True}
            , ColumnSpec{colName :: Text
colName = Text
"value", colDeclaredType :: Text
colDeclaredType = Text
"TEXT", colNotNull :: Bool
colNotNull = Bool
True}
            ]
        }
    ]

{- | A key of the artifact's @meta@ table, which holds one @TEXT@ key\/value row per key
and carries the artifact's provenance.
-}
data MetaKey
    = -- | The Pilot application version that produced the artifact.
      MetaPilotVersion
    | -- | The ecosystem Pilot compiled the artifact for (e.g. @npm@).
      MetaEcosystem
    | -- | When the compilation finished, as an ISO-8601 UTC timestamp.
      MetaBuiltAt
    | -- | The advisory source's host:port identity. Older artifacts can carry a complete URL.
      MetaSourceUrl
    | -- | The EPSS source's host:port identity. Older artifacts can carry a complete URL.
      MetaEpssSourceUrl
    | {- | The advisory source's credential-free URL, which identifies the export across runs
      where the host alone cannot.
      -}
      MetaOsvSource
    | -- | The @Last-Modified@ the advisory export answered the fetch with.
      MetaOsvLastModified
    | -- | The newest @modified@ of the advisory records the artifact was compiled from.
      MetaOsvNewestModified
    | -- | The EPSS feed's credential-free URL.
      MetaEpssSource
    | -- | The @Last-Modified@ the EPSS feed answered the fetch with.
      MetaEpssLastModified
    | -- | The @score_date@ the EPSS feed declares for its scores.
      MetaEpssScoreDate
    | -- | The scoring model the EPSS feed declares.
      MetaEpssModelVersion
    | -- | The whole-feed enrichment outcome, an 'EpssStatus'.
      MetaEpssStatus
    | -- | The number of advisory ranges the artifact holds.
      MetaRowCount
    deriving stock (MetaKey -> MetaKey -> Bool
(MetaKey -> MetaKey -> Bool)
-> (MetaKey -> MetaKey -> Bool) -> Eq MetaKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetaKey -> MetaKey -> Bool
== :: MetaKey -> MetaKey -> Bool
$c/= :: MetaKey -> MetaKey -> Bool
/= :: MetaKey -> MetaKey -> Bool
Eq, (forall x. MetaKey -> Rep MetaKey x)
-> (forall x. Rep MetaKey x -> MetaKey) -> Generic MetaKey
forall x. Rep MetaKey x -> MetaKey
forall x. MetaKey -> Rep MetaKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetaKey -> Rep MetaKey x
from :: forall x. MetaKey -> Rep MetaKey x
$cto :: forall x. Rep MetaKey x -> MetaKey
to :: forall x. Rep MetaKey x -> MetaKey
Generic, Int -> MetaKey -> FilePath -> FilePath
[MetaKey] -> FilePath -> FilePath
MetaKey -> FilePath
(Int -> MetaKey -> FilePath -> FilePath)
-> (MetaKey -> FilePath)
-> ([MetaKey] -> FilePath -> FilePath)
-> Show MetaKey
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> MetaKey -> FilePath -> FilePath
showsPrec :: Int -> MetaKey -> FilePath -> FilePath
$cshow :: MetaKey -> FilePath
show :: MetaKey -> FilePath
$cshowList :: [MetaKey] -> FilePath -> FilePath
showList :: [MetaKey] -> FilePath -> FilePath
Show)

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

-- | The key's stored form in the @meta@ table.
renderMetaKey :: MetaKey -> Text
renderMetaKey :: MetaKey -> Text
renderMetaKey = \case
    MetaKey
MetaPilotVersion -> Text
"pilot_version"
    MetaKey
MetaEcosystem -> Text
"ecosystem"
    MetaKey
MetaBuiltAt -> Text
"built_at"
    MetaKey
MetaSourceUrl -> Text
"source_url"
    MetaKey
MetaEpssSourceUrl -> Text
"epss_source_url"
    MetaKey
MetaOsvSource -> Text
"osv_source"
    MetaKey
MetaOsvLastModified -> Text
"osv_last_modified"
    MetaKey
MetaOsvNewestModified -> Text
"osv_newest_modified"
    MetaKey
MetaEpssSource -> Text
"epss_source"
    MetaKey
MetaEpssLastModified -> Text
"epss_last_modified"
    MetaKey
MetaEpssScoreDate -> Text
"epss_score_date"
    MetaKey
MetaEpssModelVersion -> Text
"epss_model_version"
    MetaKey
MetaEpssStatus -> Text
"epss_status"
    MetaKey
MetaRowCount -> Text
"row_count"

{- | Whether an ecosystem's resolved policy depends on EPSS. Where it does, Pilot publishes nothing
without enrichment and a reader refuses an artifact that lacks it.
-}
data EpssRequirement = EpssOptional | EpssRequired
    deriving stock (EpssRequirement -> EpssRequirement -> Bool
(EpssRequirement -> EpssRequirement -> Bool)
-> (EpssRequirement -> EpssRequirement -> Bool)
-> Eq EpssRequirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssRequirement -> EpssRequirement -> Bool
== :: EpssRequirement -> EpssRequirement -> Bool
$c/= :: EpssRequirement -> EpssRequirement -> Bool
/= :: EpssRequirement -> EpssRequirement -> Bool
Eq, Int -> EpssRequirement -> FilePath -> FilePath
[EpssRequirement] -> FilePath -> FilePath
EpssRequirement -> FilePath
(Int -> EpssRequirement -> FilePath -> FilePath)
-> (EpssRequirement -> FilePath)
-> ([EpssRequirement] -> FilePath -> FilePath)
-> Show EpssRequirement
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> EpssRequirement -> FilePath -> FilePath
showsPrec :: Int -> EpssRequirement -> FilePath -> FilePath
$cshow :: EpssRequirement -> FilePath
show :: EpssRequirement -> FilePath
$cshowList :: [EpssRequirement] -> FilePath -> FilePath
showList :: [EpssRequirement] -> FilePath -> FilePath
Show)

-- | The whole-feed enrichment outcome Pilot records under 'MetaEpssStatus'.
data EpssStatus
    = -- | The feed arrived and its scores joined, whether or not any advisory matched one.
      EnrichmentAvailable
    | -- | The feed failed where the ecosystem does not require it, so no score joined.
      EnrichmentUnavailable
    deriving stock (EpssStatus -> EpssStatus -> Bool
(EpssStatus -> EpssStatus -> Bool)
-> (EpssStatus -> EpssStatus -> Bool) -> Eq EpssStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssStatus -> EpssStatus -> Bool
== :: EpssStatus -> EpssStatus -> Bool
$c/= :: EpssStatus -> EpssStatus -> Bool
/= :: EpssStatus -> EpssStatus -> Bool
Eq, Int -> EpssStatus -> FilePath -> FilePath
[EpssStatus] -> FilePath -> FilePath
EpssStatus -> FilePath
(Int -> EpssStatus -> FilePath -> FilePath)
-> (EpssStatus -> FilePath)
-> ([EpssStatus] -> FilePath -> FilePath)
-> Show EpssStatus
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> EpssStatus -> FilePath -> FilePath
showsPrec :: Int -> EpssStatus -> FilePath -> FilePath
$cshow :: EpssStatus -> FilePath
show :: EpssStatus -> FilePath
$cshowList :: [EpssStatus] -> FilePath -> FilePath
showList :: [EpssStatus] -> FilePath -> FilePath
Show)

-- | The status's stored form.
renderEpssStatus :: EpssStatus -> Text
renderEpssStatus :: EpssStatus -> Text
renderEpssStatus = \case
    EpssStatus
EnrichmentAvailable -> Text
"available"
    EpssStatus
EnrichmentUnavailable -> Text
"unavailable"

-- | Whether metadata establishes successful feed enrichment, independent of individual scores.
data EpssEvidence = EpssAvailable | EpssNotEstablished
    deriving stock (EpssEvidence -> EpssEvidence -> Bool
(EpssEvidence -> EpssEvidence -> Bool)
-> (EpssEvidence -> EpssEvidence -> Bool) -> Eq EpssEvidence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EpssEvidence -> EpssEvidence -> Bool
== :: EpssEvidence -> EpssEvidence -> Bool
$c/= :: EpssEvidence -> EpssEvidence -> Bool
/= :: EpssEvidence -> EpssEvidence -> Bool
Eq, Int -> EpssEvidence -> FilePath -> FilePath
[EpssEvidence] -> FilePath -> FilePath
EpssEvidence -> FilePath
(Int -> EpssEvidence -> FilePath -> FilePath)
-> (EpssEvidence -> FilePath)
-> ([EpssEvidence] -> FilePath -> FilePath)
-> Show EpssEvidence
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> EpssEvidence -> FilePath -> FilePath
showsPrec :: Int -> EpssEvidence -> FilePath -> FilePath
$cshow :: EpssEvidence -> FilePath
show :: EpssEvidence -> FilePath
$cshowList :: [EpssEvidence] -> FilePath -> FilePath
showList :: [EpssEvidence] -> FilePath -> FilePath
Show)

-- | Only the exact stored form of 'EnrichmentAvailable' establishes enrichment.
decodeEpssEvidence :: Maybe Text -> EpssEvidence
decodeEpssEvidence :: Maybe Text -> EpssEvidence
decodeEpssEvidence Maybe Text
stored
    | Maybe Text
stored Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (EpssStatus -> Text
renderEpssStatus EpssStatus
EnrichmentAvailable) = EpssEvidence
EpssAvailable
    | Bool
otherwise = EpssEvidence
EpssNotEstablished