more import shenanigans

flora.cabal

@@ -132,6 +132,7 @@ library
     Flora.Model.PackageIndex.Update
     Flora.Model.PersistentSession
     Flora.Model.Release
+    Flora.Model.Release.Guard
     Flora.Model.Release.Query
     Flora.Model.Release.Types
     Flora.Model.Release.Update
@@ -239,6 +240,7 @@ library flora-advisories
     , aeson
     , base
     , Cabal-syntax
+    , containers
     , cvss
     , deepseq
     , effectful
@@ -526,6 +528,7 @@ test-suite flora-test
     , exceptions
     , filepath
     , flora
+    , flora-advisories
     , flora-web
     , hedgehog
     , http-client
@@ -549,6 +552,7 @@ test-suite flora-test
     , tasty-hunit
     , text
     , time
+    , tracing-effectful
     , uuid
     , vector
     , vector-algorithms

migrations/20241011153354_create_security_advisories.sql

@@ -1,16 +1,16 @@
 CREATE TABLE IF NOT EXISTS security_advisories (
-  advisory_id uuid primary key,
-  hsec_id text not null,
-  modified timestamptz not null,
-  published timestamptz not null,
-  capecs int[] not null,
-  cwes int[] not null,
-  keywords text[] not null,
-  aliases text[] not null,
-  related text[] not null,
-  advisory_references jsonb not null,
-  pandoc jsonb not null,
-  html text not null,
-  summary text not null,
-  details text not null
-)
+    advisory_id uuid PRIMARY KEY
+  , hsec_id text NOT NULL
+  , modified timestamptz NOT NULL
+  , published timestamptz NOT NULL
+  , capecs integer[] NOT NULL
+  , cwes integer[] NOT NULL
+  , keywords text[] NOT NULL
+  , aliases text[] NOT NULL
+  , related text[] NOT NULL
+  , advisory_references text[] NOT NULL
+  , pandoc jsonb NOT NULL
+  , html text NOT NULL
+  , summary text NOT NULL
+  , details text NOT NULL
+);

migrations/20241011154110_create_affected_packages.sql

@@ -1,16 +1,15 @@
 CREATE TABLE IF NOT EXISTS affected_packages (
-  affected_package_id uuid primary key,
-  advisory_id uuid references security_advisories,
-  package_id uuid references packages not null,
-  cvss text not null,
-  introduced_version uuid references releases not null,
-  fixed_version uuid references releases,
-  architectures text[],
-  operating_systems text[],
-  declarations text[][]
+    affected_package_id uuid PRIMARY KEY
+  , advisory_id uuid REFERENCES security_advisories
+  , package_id uuid REFERENCES packages NOT NULL
+  , cvss text NOT NULL
+  , architectures text[]
+  , operating_systems text[]
+  , declarations text[][]
 );
 
-CREATE INDEX affected_packages_advisory_id_fkey ON affected_packages(advisory_id);
-CREATE INDEX affected_packages_package_id_fkey ON affected_packages(package_id);
-CREATE INDEX affected_packages_introduced_version_fkey ON affected_packages(introduced_version);
-CREATE INDEX affected_packages_fixed_version_fkey ON affected_packages(fixed_version);
+CREATE INDEX affected_packages_advisory_id_fkey
+  ON affected_packages (advisory_id);
+
+CREATE INDEX affected_packages_package_id_fkey
+  ON affected_packages (package_id);

migrations/20241014081932_create_affected_version_ranges.sql

@@ -0,0 +1,12 @@
+CREATE TABLE IF NOT EXISTS affected_version_ranges (
+    affected_version_id uuid PRIMARY KEY
+  , affected_package_id uuid REFERENCES affected_packages NOT NULL
+  , introduced_version uuid REFERENCES releases (release_id) NOT NULL
+  , fixed_version uuid REFERENCES releases (release_id)
+);
+
+CREATE INDEX affected_version_ranges_introduced_version_fkey
+  ON affected_version_ranges (introduced_version);
+
+CREATE INDEX affected_version_ranges_fixed_version_fkey
+  ON affected_version_ranges (fixed_version);

src/advisories/Advisories/Import.hs

@@ -4,6 +4,7 @@ import Data.Foldable (forM_, traverse_)
 import Data.Function ((&))
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
+import Data.Set qualified as Set
 import Data.UUID.V4 qualified as UUID
 import Data.Vector (Vector)
 import Data.Vector qualified as Vector
@@ -21,8 +22,11 @@ import Advisories.Model.Advisory.Types
 import Advisories.Model.Advisory.Update qualified as Update
 import Advisories.Model.Affected.Types
 import Advisories.Model.Affected.Update qualified as Update
+import Flora.Import.Package
 import Flora.Model.Package.Guard (guardThatPackageExists)
 import Flora.Model.Package.Types
+import Flora.Model.Release.Guard (guardThatReleaseExists)
+import Flora.Model.Release.Types
 
 -- | List deduplicated parsed Advisories
 importAdvisories
@@ -74,7 +78,7 @@ processAdvisory advisoryId advisory =
     , keywords = Vector.fromList advisory.advisoryKeywords
     , aliases = Vector.fromList advisory.advisoryAliases
     , related = Vector.fromList advisory.advisoryRelated
-    , references = Vector.fromList advisory.advisoryReferences
+    , advisoryReferences = Vector.fromList advisory.advisoryReferences
     , pandoc = advisory.advisoryPandoc
     , html = advisory.advisoryHtml
     , summary = advisory.advisorySummary
@@ -91,8 +95,7 @@ processAffectedPackages
   -> Vector Affected
   -> Eff es ()
 processAffectedPackages advisoryId affectedPackages = do
-  affectedPackageDAOs <- traverse (processAffectedPackage advisoryId) affectedPackages
-  traverse_ (\p -> Update.insertAffectedPackage p) affectedPackageDAOs
+  forM_ affectedPackages (processAffectedPackage advisoryId)
 
 processAffectedPackage
   :: ( IOE :> es
@@ -102,28 +105,65 @@ processAffectedPackage
      )
   => AdvisoryId
   -> Affected
-  -> Eff es AffectedPackageDAO
+  -> Eff es ()
 processAffectedPackage advisoryId affected = do
   affectedPackageId <- AffectedPackageId <$> liftIO UUID.nextRandom
-  let namespace = Namespace "hackage"
   let packageName =
         case affected.affectedComponentIdentifier of
           Hackage affectedPackageName -> PackageName affectedPackageName
           GHC _ -> PackageName "ghc"
+  let namespace = chooseNamespace packageName "hackage" Set.empty
   package <- guardThatPackageExists namespace packageName $ \_ _ ->
     throwError (NonEmpty.singleton $ AffectedPackageNotFound namespace packageName)
   let declarations =
         affected.affectedDeclarations
-          & fmap (\(canonicalPath, affectedRange) -> AffectedDeclaration canonicalPath affectedRange)
+          & fmap (uncurry AffectedDeclaration)
           & Vector.fromList
-  pure $
-    AffectedPackageDAO
-      { affectedPackageId = affectedPackageId
-      , advisoryId = advisoryId
-      , packageId = package.packageId
-      , cvss = affected.affectedCVSS
-      , versionRanges = Vector.fromList affected.affectedVersions
-      , architectures = fmap Vector.fromList affected.affectedArchitectures
-      , operatingSystems = fmap Vector.fromList affected.affectedOS
-      , declarations = declarations
-      }
+  let affectedPackageDAO =
+        AffectedPackageDAO
+          { affectedPackageId = affectedPackageId
+          , advisoryId = advisoryId
+          , packageId = package.packageId
+          , cvss = affected.affectedCVSS
+          , architectures = fmap Vector.fromList affected.affectedArchitectures
+          , operatingSystems = fmap Vector.fromList affected.affectedOS
+          , declarations = declarations
+          }
+  Update.insertAffectedPackage affectedPackageDAO
+  processAffectedVersionRanges affectedPackageId package.packageId affected.affectedVersions
+
+processAffectedVersionRanges
+  :: ( IOE :> es
+     , DB :> es
+     , Trace :> es
+     , Error (NonEmpty AdvisoryImportError) :> es
+     )
+  => AffectedPackageId
+  -> PackageId
+  -> [AffectedVersionRange]
+  -> Eff es ()
+processAffectedVersionRanges affectedPackageId packageId affectedVersions = do
+  traverse_
+    ( \affectedVersion -> do
+        affectedVersionId <- AffectedVersionId <$> liftIO UUID.nextRandom
+        introducedReleaseId <- do
+          release <- guardThatReleaseExists packageId affectedVersion.affectedVersionRangeIntroduced $ \version ->
+            throwError (NonEmpty.singleton $ AffectedVersionNotFound packageId version)
+          pure release.releaseId
+        mFixedReleaseId <- case affectedVersion.affectedVersionRangeFixed of
+          Nothing -> pure Nothing
+          Just version -> do
+            release <- guardThatReleaseExists packageId version $ \version ->
+              throwError (NonEmpty.singleton $ AffectedVersionNotFound packageId version)
+            pure $ Just release.releaseId
+        let versionRangeDAO =
+              AffectedVersionRangeDAO
+                { affectedVersionId = affectedVersionId
+                , affectedPackageId = affectedPackageId
+                , introducedVersion = introducedReleaseId
+                , fixedVersion = mFixedReleaseId
+                }
+
+        Update.insertAffectedVersionRange versionRangeDAO
+    )
+    affectedVersions

src/advisories/Advisories/Import/Error.hs

@@ -1,5 +1,6 @@
 module Advisories.Import.Error where
 
+import Distribution.Types.Version (Version)
 import GHC.Generics
 import Security.Advisories.Parse
 
@@ -8,5 +9,6 @@ import Flora.Model.Package.Types
 data AdvisoryImportError
   = AffectedPackageNotFound Namespace PackageName
   | AdvisoryParsingError (FilePath, ParseAdvisoryError)
+  | AffectedVersionNotFound PackageId Version
   | FackinHell
   deriving stock (Eq, Show, Generic)

src/advisories/Advisories/Model/Advisory/Types.hs

@@ -37,7 +37,7 @@ data AdvisoryDAO = AdvisoryDAO
   , keywords :: Vector Keyword
   , aliases :: Vector Text
   , related :: Vector Text
-  , references :: Vector Reference
+  , advisoryReferences :: Vector Reference
   , pandoc :: Pandoc
   , html :: Text
   , summary :: Text

src/advisories/Advisories/Model/Affected/Types.hs

@@ -22,6 +22,7 @@ import Advisories.System.Orphans ()
 import Distribution.Orphans.ConfVar ()
 import Distribution.Orphans.Version ()
 import Flora.Model.Package.Types
+import Flora.Model.Release.Types
 
 newtype AffectedPackageId = AffectedPackageId {getAffectedPackageId :: UUID}
   deriving stock (Generic, Show)
@@ -34,7 +35,6 @@ data AffectedPackageDAO = AffectedPackageDAO
   , advisoryId :: AdvisoryId
   , packageId :: PackageId
   , cvss :: CVSS
-  , versionRanges :: Vector AffectedVersionRange
   , architectures :: Maybe (Vector Architecture)
   , operatingSystems :: Maybe (Vector OS)
   , declarations :: Vector AffectedDeclaration
@@ -55,3 +55,21 @@ data AffectedDeclaration = AffectedDeclaration
 deriving via (Aeson AffectedDeclaration) instance ToField AffectedDeclaration
 
 deriving via (Aeson AffectedDeclaration) instance FromField AffectedDeclaration
+
+newtype AffectedVersionId = AffectedVersionId {getAffectedVersionId :: UUID}
+  deriving stock (Generic, Show)
+  deriving
+    (Eq, Ord, FromJSON, ToJSON, FromField, ToField, NFData)
+    via UUID
+
+data AffectedVersionRangeDAO = AffectedVersionRangeDAO
+  { affectedVersionId :: AffectedVersionId
+  , affectedPackageId :: AffectedPackageId
+  , introducedVersion :: ReleaseId
+  , fixedVersion :: Maybe ReleaseId
+  }
+  deriving stock (Show, Generic)
+  deriving anyclass (FromRow, ToRow, NFData)
+  deriving
+    (Entity)
+    via (GenericEntity '[TableName "affected_version_ranges"] AffectedVersionRangeDAO)

src/advisories/Advisories/Model/Affected/Update.hs

@@ -11,3 +11,9 @@ insertAffectedPackage
   => AffectedPackageDAO
   -> Eff es ()
 insertAffectedPackage = dbtToEff . insert @AffectedPackageDAO
+
+insertAffectedVersionRange
+  :: DB :> es
+  => AffectedVersionRangeDAO
+  -> Eff es ()
+insertAffectedVersionRange = dbtToEff . insert @AffectedVersionRangeDAO

src/core/Flora/Model/Release/Guard.hs

@@ -0,0 +1,26 @@
+module Flora.Model.Release.Guard where
+
+import Distribution.Types.Version (Version)
+import Effectful
+import Effectful.PostgreSQL.Transact.Effect
+import Effectful.Trace
+import Monitor.Tracing qualified as Tracing
+
+import Flora.Model.Package.Types
+import Flora.Model.Release.Query qualified as Query
+import Flora.Model.Release.Types
+
+guardThatReleaseExists
+  :: (DB :> es, Trace :> es)
+  => PackageId
+  -> Version
+  -> (Version -> Eff es Release)
+  -- ^ Action to run if the package does not exist
+  -> Eff es Release
+guardThatReleaseExists packageId version action = do
+  result <-
+    Tracing.childSpan "Query.getReleaseByVersion" $
+      Query.getReleaseByVersion packageId version
+  case result of
+    Just release -> pure release
+    Nothing -> action version

src/datatypes/Advisories/AffectedVersionRange/Orphans.hs

@@ -5,9 +5,6 @@ module Advisories.AffectedVersionRange.Orphans where
 import Control.DeepSeq
 import Data.Aeson
 import Data.Text.Display
-import Database.PostgreSQL.Simple.FromField
-import Database.PostgreSQL.Simple.Newtypes (Aeson (..))
-import Database.PostgreSQL.Simple.ToField (ToField (..))
 import Security.Advisories.Core.Advisory
 
 import Distribution.Orphans.Version ()
@@ -28,9 +25,5 @@ instance FromJSON AffectedVersionRange where
     affectedVersionRangeFixed <- o .:? "fixed"
     pure AffectedVersionRange{..}
 
-deriving via (Aeson AffectedVersionRange) instance ToField AffectedVersionRange
-
-deriving via (Aeson AffectedVersionRange) instance FromField AffectedVersionRange
-
 instance NFData AffectedVersionRange where
   rnf a = seq a ()

src/web/FloraWeb/API/Server/Packages.hs

@@ -13,12 +13,12 @@ import Servant hiding ((:>))
 import Flora.Model.Component.Query qualified as Query
 import Flora.Model.Package.Guard
 import Flora.Model.Package.Types
+import Flora.Model.Release.Guard (guardThatReleaseExists)
 import Flora.Model.Release.Query qualified as Query
 import Flora.Model.Release.Types
 import FloraWeb.API.Errors
 import FloraWeb.API.Routes.Packages qualified as Packages
 import FloraWeb.API.Routes.Packages.Types (PackageDTO, toPackageDTO)
-import FloraWeb.Common.Guards
 import FloraWeb.Types
 
 packagesServer :: ServerT Packages.API FloraEff