From 6be5f6a69204562312e033a1697aea165e209666 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri=20de=20Tarl=C3=A9?= Date: Fri, 8 Nov 2024 22:13:18 +0100 Subject: [PATCH] Split the import and insertion of advisories --- ghc-tags.yaml | 1 + src/advisories/Advisories/Import.hs | 48 ++++++++++++++--------- src/advisories/Advisories/Import/Error.hs | 1 - 3 files changed, 31 insertions(+), 19 deletions(-) diff --git a/ghc-tags.yaml b/ghc-tags.yaml index 24e60c74..893cc798 100644 --- a/ghc-tags.yaml +++ b/ghc-tags.yaml @@ -5,6 +5,7 @@ exclude_paths: - dist - dist-newstyle - assets +- _build extensions: - BangPatterns - BlockArguments diff --git a/src/advisories/Advisories/Import.hs b/src/advisories/Advisories/Import.hs index 0543df46..1eb638ce 100644 --- a/src/advisories/Advisories/Import.hs +++ b/src/advisories/Advisories/Import.hs @@ -29,27 +29,39 @@ import Flora.Model.Release.Guard (guardThatReleaseExists) import Flora.Model.Release.Types import OSV.Reference.Orphans --- | List deduplicated parsed Advisories -importAdvisories - :: ( DB :> es - , Trace :> es +processAdvisories + :: ( Trace :> es , IOE :> es + , DB :> es , Error (NonEmpty AdvisoryImportError) :> es ) => FilePath -> Eff es () +processAdvisories root = do + importResult <- importAdvisories root + case importResult of + Failure failures -> + throwError failures + Success advisories -> + forM_ advisories $ \advisory -> processAdvisory advisory + +-- | List deduplicated parsed Advisories +importAdvisories + :: ( Trace :> es + , IOE :> es + ) + => FilePath + -> Eff es (Validation (NonEmpty AdvisoryImportError) (Vector Advisory)) importAdvisories root = Tracing.rootSpan alwaysSampled "import-advisories" $ do result <- Tracing.childSpan "listAdvisories" $ listAdvisories root case result of Failure failures -> - let errors = case NonEmpty.nonEmpty failures of - Just nonEmptyFailures -> fmap AdvisoryParsingError nonEmptyFailures - Nothing -> NonEmpty.singleton FackinHell - in throwError errors - Success advisoryList -> do - forM_ advisoryList $ \advisory -> importAdvisory advisory + case NonEmpty.nonEmpty failures of + Just nonEmptyFailures -> pure $ Failure (fmap AdvisoryParsingError nonEmptyFailures) + Nothing -> error $ "Could not convert list of failures to non-empty: " <> show failures + Success advisoryList -> pure $ Success $ Vector.fromList advisoryList -importAdvisory +processAdvisory :: ( DB :> es , Trace :> es , IOE :> es @@ -57,18 +69,18 @@ importAdvisory ) => Advisory -> Eff es () -importAdvisory advisory = do +processAdvisory advisory = do advisoryId <- AdvisoryId <$> liftIO UUID.nextRandom let advisoryAffectedPackages = Vector.fromList advisory.advisoryAffected - let advisoryDAO = processAdvisory advisoryId advisory + let advisoryDAO = mkAdvisory advisoryId advisory Update.insertAdvisory advisoryDAO processAffectedPackages advisoryId advisoryAffectedPackages -processAdvisory +mkAdvisory :: AdvisoryId -> Advisory -> AdvisoryDAO -processAdvisory advisoryId advisory = +mkAdvisory advisoryId advisory = AdvisoryDAO { advisoryId = advisoryId , hsecId = advisory.advisoryId @@ -113,7 +125,7 @@ processAffectedPackage advisoryId affected = do case affected.affectedComponentIdentifier of Hackage affectedPackageName -> PackageName affectedPackageName GHC _ -> PackageName "ghc" - let namespace = chooseNamespace packageName "hackage" Set.empty + let namespace = chooseNamespace packageName ("hackage", Set.empty) package <- guardThatPackageExists namespace packageName $ \_ _ -> throwError (NonEmpty.singleton $ AffectedPackageNotFound namespace packageName) let declarations = @@ -154,8 +166,8 @@ processAffectedVersionRanges affectedPackageId packageId affectedVersions = do mFixedReleaseId <- case affectedVersion.affectedVersionRangeFixed of Nothing -> pure Nothing Just version -> do - release <- guardThatReleaseExists packageId version $ \version -> - throwError (NonEmpty.singleton $ AffectedVersionNotFound packageId version) + release <- guardThatReleaseExists packageId version $ \releaseVersion -> + throwError (NonEmpty.singleton $ AffectedVersionNotFound packageId releaseVersion) pure $ Just release.releaseId let versionRangeDAO = AffectedVersionRangeDAO diff --git a/src/advisories/Advisories/Import/Error.hs b/src/advisories/Advisories/Import/Error.hs index 8d761a78..d6671a9b 100644 --- a/src/advisories/Advisories/Import/Error.hs +++ b/src/advisories/Advisories/Import/Error.hs @@ -10,5 +10,4 @@ data AdvisoryImportError = AffectedPackageNotFound Namespace PackageName | AdvisoryParsingError (FilePath, ParseAdvisoryError) | AffectedVersionNotFound PackageId Version - | FackinHell deriving stock (Eq, Show, Generic)