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

{- | The advisory lookup's internals: the hardened SQLite open and the raw
queries "Ecluse.Core.Cve" curates into the public handle.

Importing this module opts out of the public surface's stability promises; it
exists so tests can pin the hardening properties (the connection refuses
writes, schema-borne SQL is distrusted) directly against the connection the
handle actually uses.
-}
module Ecluse.Core.Cve.Internal (
    AdvisoryRange (..),
    CveDbRejected (..),
    openHardenedConnection,
    probeQuery,
    advisoriesQuery,
    provenanceQuery,
) where

import Database.SQLite.Simple (Connection, Only (..), SQLError, close, execute_, open, query, query_)
import UnliftIO.Exception (onException, try)

import Ecluse.Core.Ecosystem (Ecosystem, ecosystemName)
import Ecluse.Core.Osv.Schema (ColumnSpec (..), MetaKey (MetaEcosystem), TableSpec (..), osvSchemaEpoch, osvTableSpecs, renderMetaKey)

{- | One advisory segment recorded against a package: the advisory's identifier,
its CVSS base score (0 to 10, 'Nothing' when unscored), and the affected
interval's bounds as the artifact stores them (verbatim version text). The lower
bound 'arIntroduced' is inclusive ('Nothing' == from the beginning); the upper
bound is @'arFixed'@ (exclusive) or @'arLastAffected'@ (inclusive) or neither
(open-ended). An exactly-enumerated affected version is a point segment
(@introduced == last_affected@).
-}
data AdvisoryRange = AdvisoryRange
    { AdvisoryRange -> Text
arCveId :: Text
    , AdvisoryRange -> Maybe Double
arSeverity :: Maybe Double
    , AdvisoryRange -> Maybe Text
arIntroduced :: Maybe Text
    , AdvisoryRange -> Maybe Text
arFixed :: Maybe Text
    , AdvisoryRange -> Maybe Text
arLastAffected :: Maybe Text
    }
    deriving stock (AdvisoryRange -> AdvisoryRange -> Bool
(AdvisoryRange -> AdvisoryRange -> Bool)
-> (AdvisoryRange -> AdvisoryRange -> Bool) -> Eq AdvisoryRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AdvisoryRange -> AdvisoryRange -> Bool
== :: AdvisoryRange -> AdvisoryRange -> Bool
$c/= :: AdvisoryRange -> AdvisoryRange -> Bool
/= :: AdvisoryRange -> AdvisoryRange -> Bool
Eq, Int -> AdvisoryRange -> ShowS
[AdvisoryRange] -> ShowS
AdvisoryRange -> String
(Int -> AdvisoryRange -> ShowS)
-> (AdvisoryRange -> String)
-> ([AdvisoryRange] -> ShowS)
-> Show AdvisoryRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AdvisoryRange -> ShowS
showsPrec :: Int -> AdvisoryRange -> ShowS
$cshow :: AdvisoryRange -> String
show :: AdvisoryRange -> String
$cshowList :: [AdvisoryRange] -> ShowS
showList :: [AdvisoryRange] -> ShowS
Show)

{- | Why a downloaded artifact was refused before a handle was built over it.

A rejection is a value, not an exception: the caller (the sync task, once it
exists) has a real decision to make, keep the last known-good database and
alarm, rather than a fault to unwind from.
-}
data CveDbRejected
    = {- | The artifact's @user_version@ stamp (carried) does not match this
      binary's 'osvSchemaEpoch'.
      -}
      CveDbWrongEpoch Int
    | {- | The artifact is not a usable SQLite database: either it is not a
      database at all (absent or wrong header magic, which SQLite reports as
      @SQLITE_NOTADB@ on the first header read), or @PRAGMA quick_check@ found it
      structurally corrupt (a malformed, truncated, or crafted b-tree). The
      carried lines are the thrown error or the integrity report (which SQLite
      caps at 100 problems).
      -}
      CveDbIntegrityFailed [Text]
    | {- | A required relation (carried) does not conform to the epoch's schema
      contract: absent, not a real @STRICT@ table, or missing a required column
      with its declared type. A view here is attacker-authored SQL wearing the
      table's name; a lax (non-@STRICT@) table would leave the reader's decodes
      exposed to type-confused values.
      -}
      CveDbSchemaNonConformant Text
    | {- | The artifact's @meta@ table names a different ecosystem (carried) than
      the one this handle was asked to serve, or carries no ecosystem row at all
      so the ecosystem cannot be confirmed ('Nothing'). An absent @meta@ table
      is caught earlier, as 'CveDbSchemaNonConformant'.
      -}
      CveDbEcosystemMismatch (Maybe Text)
    deriving stock (CveDbRejected -> CveDbRejected -> Bool
(CveDbRejected -> CveDbRejected -> Bool)
-> (CveDbRejected -> CveDbRejected -> Bool) -> Eq CveDbRejected
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CveDbRejected -> CveDbRejected -> Bool
== :: CveDbRejected -> CveDbRejected -> Bool
$c/= :: CveDbRejected -> CveDbRejected -> Bool
/= :: CveDbRejected -> CveDbRejected -> Bool
Eq, Int -> CveDbRejected -> ShowS
[CveDbRejected] -> ShowS
CveDbRejected -> String
(Int -> CveDbRejected -> ShowS)
-> (CveDbRejected -> String)
-> ([CveDbRejected] -> ShowS)
-> Show CveDbRejected
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CveDbRejected -> ShowS
showsPrec :: Int -> CveDbRejected -> ShowS
$cshow :: CveDbRejected -> String
show :: CveDbRejected -> String
$cshowList :: [CveDbRejected] -> ShowS
showList :: [CveDbRejected] -> ShowS
Show)

{- | Open an artifact read-only-in-effect and accept or reject it.

Hardening order matters, and every pragma is applied before the first query.
@trusted_schema = OFF@ distrusts schema-defined functions, views feeding
triggers, and virtual tables in the file; @query_only = ON@ refuses every write,
so no trigger can ever fire through the connection; @cell_size_check = ON@
validates each b-tree cell against its page as pages are read, so a crafted
oversized cell becomes a clean error rather than an out-of-bounds access; and
@mmap_size = 0@ keeps reads on the bounds-checked pager instead of mapping
hostile file pages straight into the address space.

Acceptance then checks, cheapest and least trusting first: the 'osvSchemaEpoch'
stamp (a header field, so a stale, substituted, or non-SQLite artifact is refused
before the file's interior is walked at all), a @PRAGMA quick_check@ integrity
walk (a malformed or truncated b-tree is rejected before any lookup dereferences
it, and stored values are verified against each @STRICT@ table's declared column
types), the required tables conforming to the epoch's schema contract
('osvTableSpecs': real @STRICT@ tables carrying the required columns with their
declared types, which is what makes every later row decode total), and the
@meta@ ecosystem matching the one asked for. A rejected artifact's connection is closed
before returning, and so is a connection whose hardening or acceptance /throws/
before it can return a rejection value: the whole phase runs under a
close-on-exception guard, so the just-opened connection is never leaked (the
"an exception never leaks it" contract 'Ecluse.Core.Cve.openCveDb' promises).

Read-only is enforced at the connection level: sqlite-simple's public API has
no way to pass @SQLITE_OPEN_READONLY@ at open time, and @query_only@ yields
the same guarantee for every statement this connection will run.
-}
openHardenedConnection :: Ecosystem -> FilePath -> IO (Either CveDbRejected Connection)
openHardenedConnection :: Ecosystem -> String -> IO (Either CveDbRejected Connection)
openHardenedConnection Ecosystem
eco String
dbFile = do
    conn <- String -> IO Connection
open String
dbFile
    -- Apply the hardening pragmas and accept-or-reject the artifact. Acceptance
    -- folds a hostile artifact into a 'CveDbRejected' value; the 'onException'
    -- guard closes the connection should a statement instead throw (e.g. a
    -- non-SQLite file whose first file-touching pragma raises), so the
    -- just-opened connection is never leaked on that path.
    let hardenAndAccept = do
            Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA trusted_schema = OFF"
            Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA query_only = ON"
            Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA cell_size_check = ON"
            Connection -> Query -> IO ()
execute_ Connection
conn Query
"PRAGMA mmap_size = 0"
            Ecosystem -> Connection -> IO (Either CveDbRejected ())
acceptArtifact Ecosystem
eco Connection
conn
    accepted <- hardenAndAccept `onException` close conn
    case accepted of
        Left CveDbRejected
rejection -> do
            Connection -> IO ()
close Connection
conn
            Either CveDbRejected Connection
-> IO (Either CveDbRejected Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CveDbRejected -> Either CveDbRejected Connection
forall a b. a -> Either a b
Left CveDbRejected
rejection)
        Right () -> Either CveDbRejected Connection
-> IO (Either CveDbRejected Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Connection -> Either CveDbRejected Connection
forall a b. b -> Either a b
Right Connection
conn)

acceptArtifact :: Ecosystem -> Connection -> IO (Either CveDbRejected ())
acceptArtifact :: Ecosystem -> Connection -> IO (Either CveDbRejected ())
acceptArtifact Ecosystem
eco Connection
conn = ExceptT CveDbRejected IO () -> IO (Either CveDbRejected ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CveDbRejected IO () -> IO (Either CveDbRejected ()))
-> ExceptT CveDbRejected IO () -> IO (Either CveDbRejected ())
forall a b. (a -> b) -> a -> b
$ do
    IO (Either CveDbRejected ()) -> ExceptT CveDbRejected IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Connection -> IO (Either CveDbRejected ())
checkEpochStamp Connection
conn)
    IO (Either CveDbRejected ()) -> ExceptT CveDbRejected IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Connection -> IO (Either CveDbRejected ())
checkIntegrity Connection
conn)
    (TableSpec -> ExceptT CveDbRejected IO ())
-> [TableSpec] -> ExceptT CveDbRejected IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO (Either CveDbRejected ()) -> ExceptT CveDbRejected IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either CveDbRejected ()) -> ExceptT CveDbRejected IO ())
-> (TableSpec -> IO (Either CveDbRejected ()))
-> TableSpec
-> ExceptT CveDbRejected IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> TableSpec -> IO (Either CveDbRejected ())
checkTableConformance Connection
conn) [TableSpec]
osvTableSpecs
    IO (Either CveDbRejected ()) -> ExceptT CveDbRejected IO ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Ecosystem -> Connection -> IO (Either CveDbRejected ())
checkMetaEcosystem Ecosystem
eco Connection
conn)

checkEpochStamp :: Connection -> IO (Either CveDbRejected ())
checkEpochStamp :: Connection -> IO (Either CveDbRejected ())
checkEpochStamp Connection
conn = do
    -- @PRAGMA user_version@ is the first statement to read the file's header, so
    -- a non-SQLite artifact (absent or wrong header magic) raises @SQLITE_NOTADB@
    -- here rather than returning a stamp. Fold that throw into a rejection value,
    -- exactly as 'checkIntegrity' folds a b-tree walk that aborts: a hostile
    -- artifact is refused as a value the sync task can remember (so it is not
    -- re-downloaded every poll), never a fault that unwinds and leaks the
    -- connection.
    stamped <- IO [Only Int] -> IO (Either SQLError [Only Int])
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (Connection -> Query -> IO [Only Int]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"PRAGMA user_version") :: IO (Either SQLError [Only Int])
    pure $ case stamped of
        Left SQLError
err -> CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left ([Text] -> CveDbRejected
CveDbIntegrityFailed [Text
"not a valid SQLite database: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SQLError -> Text
forall b a. (Show a, IsString b) => a -> b
show SQLError
err])
        Right [Only Int]
rows -> case (Only Int -> Int) -> [Only Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Only Int -> Int
forall a. Only a -> a
fromOnly [Only Int]
rows of
            [Int
epoch]
                | Int
epoch Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
osvSchemaEpoch -> () -> Either CveDbRejected ()
forall a b. b -> Either a b
Right ()
                | Bool
otherwise -> CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left (Int -> CveDbRejected
CveDbWrongEpoch Int
epoch)
            [Int]
_ -> CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left (Int -> CveDbRejected
CveDbWrongEpoch Int
0)

{- | Walk the whole database structure and refuse an artifact SQLite reports as
corrupt. @quick_check@ (unlike full @integrity_check@) skips the index-vs-table
content cross-validation we do not rely on, keeping the scan to the structural
soundness a hostile file could weaponise; it returns a single @ok@ on success.

A well-formed database reports its problems as result rows, but a badly enough
mangled b-tree can abort the walk with @SQLITE_CORRUPT@ instead. Both are the
same verdict here, so the thrown error is caught and folded into the rejection
rather than propagated: a hostile artifact is refused, never a fault to unwind.
-}
checkIntegrity :: Connection -> IO (Either CveDbRejected ())
checkIntegrity :: Connection -> IO (Either CveDbRejected ())
checkIntegrity Connection
conn = do
    result <- IO [Only Text] -> IO (Either SQLError [Only Text])
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (Connection -> Query -> IO [Only Text]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"PRAGMA quick_check") :: IO (Either SQLError [Only Text])
    pure $ case result of
        Left SQLError
err -> CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left ([Text] -> CveDbRejected
CveDbIntegrityFailed [SQLError -> Text
forall b a. (Show a, IsString b) => a -> b
show SQLError
err])
        Right [Only Text]
report -> case (Only Text -> Text) -> [Only Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Only Text -> Text
forall a. Only a -> a
fromOnly [Only Text]
report of
            [Text
"ok"] -> () -> Either CveDbRejected ()
forall a b. b -> Either a b
Right ()
            [Text]
problems -> CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left ([Text] -> CveDbRejected
CveDbIntegrityFailed [Text]
problems)

{- | Does the artifact carry this relation as the schema contract demands: a
real @STRICT@ table with every required column under its declared type (and
@NOT NULL@ where the reader's decode relies on it)? Columns beyond the spec are
tolerated, keeping additive schema changes epoch-neutral. This declaration
check is one half of the totality guarantee; 'checkIntegrity' is the other,
verifying the stored values actually conform to the @STRICT@ declaration.

Any SQLite throw folds into the rejection so acceptance stays total at the
type: a read fault here is a refusal value the sync task remembers, never an
exception that unwinds and re-fetches the artifact every poll. The pragma rows
decode through 'Maybe' for the same reason -- nothing an artifact carries may
make this check throw.
-}
checkTableConformance :: Connection -> TableSpec -> IO (Either CveDbRejected ())
checkTableConformance :: Connection -> TableSpec -> IO (Either CveDbRejected ())
checkTableConformance Connection
conn TableSpec
spec = do
    listed <- IO [(Maybe Text, Maybe Int)]
-> IO (Either SQLError [(Maybe Text, Maybe Int)])
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (Connection -> Query -> Only Text -> IO [(Maybe Text, Maybe Int)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT type, strict FROM pragma_table_list WHERE name = ?" (Text -> Only Text
forall a. a -> Only a
Only (TableSpec -> Text
tableName TableSpec
spec))) :: IO (Either SQLError [(Maybe Text, Maybe Int)])
    columns <- try (query conn "SELECT name, type, \"notnull\" FROM pragma_table_xinfo(?)" (Only (tableName spec))) :: IO (Either SQLError [(Maybe Text, Maybe Text, Maybe Int)])
    pure $ case (listed, columns) of
        (Right [(Just Text
"table", Just Int
1)], Right [(Maybe Text, Maybe Text, Maybe Int)]
cols)
            | (ColumnSpec -> Bool) -> [ColumnSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([(Maybe Text, Maybe Text, Maybe Int)] -> ColumnSpec -> Bool
hasConformingColumn [(Maybe Text, Maybe Text, Maybe Int)]
cols) (TableSpec -> [ColumnSpec]
tableColumns TableSpec
spec) -> () -> Either CveDbRejected ()
forall a b. b -> Either a b
Right ()
        (Either SQLError [(Maybe Text, Maybe Int)],
 Either SQLError [(Maybe Text, Maybe Text, Maybe Int)])
_ -> CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left (Text -> CveDbRejected
CveDbSchemaNonConformant (TableSpec -> Text
tableName TableSpec
spec))

-- Is the required column among the table's actual columns, under its declared
-- type and (where the decode relies on it) NOT NULL?
hasConformingColumn :: [(Maybe Text, Maybe Text, Maybe Int)] -> ColumnSpec -> Bool
hasConformingColumn :: [(Maybe Text, Maybe Text, Maybe Int)] -> ColumnSpec -> Bool
hasConformingColumn [(Maybe Text, Maybe Text, Maybe Int)]
cols ColumnSpec
spec = ((Maybe Text, Maybe Text, Maybe Int) -> Bool)
-> [(Maybe Text, Maybe Text, Maybe Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Text, Maybe Text, Maybe Int) -> Bool
forall {a}.
(Eq a, Num a) =>
(Maybe Text, Maybe Text, Maybe a) -> Bool
conforms [(Maybe Text, Maybe Text, Maybe Int)]
cols
  where
    conforms :: (Maybe Text, Maybe Text, Maybe a) -> Bool
conforms (Maybe Text
name, Maybe Text
declaredType, Maybe a
notnull) =
        Maybe Text
name Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnSpec -> Text
colName ColumnSpec
spec)
            Bool -> Bool -> Bool
&& Maybe Text
declaredType Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (ColumnSpec -> Text
colDeclaredType ColumnSpec
spec)
            Bool -> Bool -> Bool
&& (Bool -> Bool
not (ColumnSpec -> Bool
colNotNull ColumnSpec
spec) Bool -> Bool -> Bool
|| Maybe a
notnull Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
1)

checkMetaEcosystem :: Ecosystem -> Connection -> IO (Either CveDbRejected ())
checkMetaEcosystem :: Ecosystem -> Connection -> IO (Either CveDbRejected ())
checkMetaEcosystem Ecosystem
eco Connection
conn = do
    -- By this point conformance has confirmed @meta@ is a real STRICT table of
    -- NOT NULL TEXT, and the integrity walk has verified the stored values, so
    -- the row decode here is total. The try-fold stays as the siblings' shape:
    -- should SQLite still throw, that is a refusal value the sync task
    -- remembers, never an exception that re-fetches the artifact every poll.
    named <- IO [Only Text] -> IO (Either SQLError [Only Text])
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (Connection -> Query -> Only Text -> IO [Only Text]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT value FROM meta WHERE key = ?" (Text -> Only Text
forall a. a -> Only a
Only (MetaKey -> Text
renderMetaKey MetaKey
MetaEcosystem))) :: IO (Either SQLError [Only Text])
    pure $ case named of
        Left SQLError
_ -> CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left (Maybe Text -> CveDbRejected
CveDbEcosystemMismatch Maybe Text
forall a. Maybe a
Nothing)
        Right [Only Text]
rows ->
            let found :: Maybe Text
found = Only Text -> Text
forall a. Only a -> a
fromOnly (Only Text -> Text) -> Maybe (Only Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Only Text] -> Maybe (Only Text)
forall a. [a] -> Maybe a
listToMaybe [Only Text]
rows
             in if Maybe Text
found Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (Ecosystem -> Text
ecosystemName Ecosystem
eco)
                    then () -> Either CveDbRejected ()
forall a b. b -> Either a b
Right ()
                    else CveDbRejected -> Either CveDbRejected ()
forall a b. a -> Either a b
Left (Maybe Text -> CveDbRejected
CveDbEcosystemMismatch Maybe Text
found)

{- | Does any advisory for this package name this exact version string as a
fixed bound? One indexed probe (@package_name, fixed_version@); deliberately
string equality, per the artifact contract's canonical-semver expectation.
-}
probeQuery :: Connection -> Text -> Text -> IO Bool
probeQuery :: Connection -> Text -> Text -> IO Bool
probeQuery Connection
conn Text
name Text
version = do
    hits <- Connection -> Query -> (Text, Text) -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT 1 FROM package_vulnerability_ranges WHERE package_name = ? AND fixed_version = ? LIMIT 1" (Text
name, Text
version) :: IO [Only Int]
    pure (not (null hits))

-- | Every advisory segment recorded against a package name.
advisoriesQuery :: Connection -> Text -> IO [AdvisoryRange]
advisoriesQuery :: Connection -> Text -> IO [AdvisoryRange]
advisoriesQuery Connection
conn Text
name = do
    rows <- Connection
-> Query
-> Only Text
-> IO [(Text, Maybe Text, Maybe Text, Maybe Text, Maybe Double)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT cve_id, introduced_version, fixed_version, last_affected_version, severity FROM package_vulnerability_ranges WHERE package_name = ?" (Text -> Only Text
forall a. a -> Only a
Only Text
name)
    pure (map toRange rows)
  where
    toRange :: (Text, Maybe Text, Maybe Text, Maybe Text, Maybe Double)
-> AdvisoryRange
toRange (Text
cveId, Maybe Text
intro, Maybe Text
fixed, Maybe Text
lastAffected, Maybe Double
severity) =
        AdvisoryRange
            { arCveId :: Text
arCveId = Text
cveId
            , arIntroduced :: Maybe Text
arIntroduced = Maybe Text
intro
            , arFixed :: Maybe Text
arFixed = Maybe Text
fixed
            , arLastAffected :: Maybe Text
arLastAffected = Maybe Text
lastAffected
            , arSeverity :: Maybe Double
arSeverity = Maybe Double
severity
            }

{- | The artifact's @meta@ provenance rows, key-sorted for a deterministic
snapshot. This only ever runs on an accepted connection, and acceptance has
confirmed @meta@ is a @STRICT@ table of @NOT NULL TEXT@ whose stored values the
integrity walk verified, so the @(Text, Text)@ decode is total here: no
artifact content can make it throw.
-}
provenanceQuery :: Connection -> IO [(Text, Text)]
provenanceQuery :: Connection -> IO [(Text, Text)]
provenanceQuery Connection
conn = Connection -> Query -> IO [(Text, Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"SELECT key, value FROM meta ORDER BY key"