-
Notifications
You must be signed in to change notification settings - Fork 18
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
[wip] add part of the implementation of looking up advisories in the DB
- Loading branch information
Showing
5 changed files
with
151 additions
and
25 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,4 +1,86 @@ | ||
| module Security.Advisories.Cabal where | ||
| {-# LANGUAGE StrictData #-} | ||
| {-# LANGUAGE UndecidableInstances #-} | ||
|
|
||
| module Security.Advisories.Cabal (matchAdvisoriesForPlan) where | ||
|
|
||
| import Data.Functor.Identity (Identity(Identity)) | ||
| import Data.Kind (Type) | ||
| import Data.Map (Map, (!?)) | ||
| import Data.Map.Strict qualified as Map | ||
| import Data.Proxy (Proxy (Proxy)) | ||
| import Data.Text qualified as T | ||
| import Distribution.Client.InstallPlan (foldPlanPackage) | ||
| import Distribution.Client.InstallPlan qualified as Plan | ||
| import Distribution.Client.ProjectPlanning (ElaboratedInstallPlan, elabPkgSourceId) | ||
| import Distribution.InstalledPackageInfo (sourcePackageId) | ||
| import Distribution.Package (PackageIdentifier (PackageIdentifier, pkgName, pkgVersion), PackageName, mkPackageName) | ||
| import Distribution.Version (Version) | ||
| import GHC.Generics (Generic) | ||
| import Security.Advisories (Advisory (advisoryAffected), Affected (Affected, affectedPackage, affectedVersions), AffectedVersionRange) | ||
| import Data.Maybe (mapMaybe) | ||
|
|
||
| -- | for a given 'ElaboratedInstallPlan' and a list of advisories, construct a map of advisories | ||
| -- and packages within the install plan that are affected by them | ||
| matchAdvisoriesForPlan | ||
| :: ElaboratedInstallPlan | ||
| -- ^ the plan as created by cabal | ||
| -> [Advisory] | ||
| -- ^ the advisories as discovered in some advisory dir | ||
| -> Map PackageName ElaboratedPackageInfoAdvised | ||
| matchAdvisoriesForPlan plan = foldr advise Map.empty | ||
| where | ||
| advise :: Advisory -> Map PackageName ElaboratedPackageInfoAdvised -> Map PackageName ElaboratedPackageInfoAdvised | ||
| advise adv = do | ||
| let versionAffected :: Version -> [AffectedVersionRange] -> Bool | ||
| versionAffected = undefined | ||
|
|
||
| advPkgs :: [ElaboratedPackageInfoAdvised] | ||
| advPkgs = flip mapMaybe (advisoryAffected adv) \Affected {affectedPackage, affectedVersions} -> do | ||
| MkElaboratedPackageInfoWith {elaboratedPackageVersion = elabv} <- planTable !? mkPackageName (T.unpack affectedPackage) | ||
| if versionAffected elabv affectedVersions | ||
| then Just (MkElaboratedPackageInfoWith {elaboratedPackageVersion = elabv, packageAdvisories = Identity [adv]}) | ||
| else Nothing | ||
|
|
||
| Map.insertWith _ _ _ | ||
|
|
||
| combinedElaboratedPackageInfos MkElaboratedPackageInfoWith {elaboratedPackageVersion = ver1, packageAdvisories = advs1} advs2 = | ||
| MkElaboratedPackageInfoWith {elaboratedPackageVersion = ver1, packageAdvisories = advs1 <> advs2} | ||
|
|
||
| planTable = installPlanToLookupTable plan | ||
|
|
||
| type ElaboratedPackageInfoAdvised = ElaboratedPackageInfoWith Identity | ||
|
|
||
| type ElaboratedPackageInfo = ElaboratedPackageInfoWith Proxy | ||
|
|
||
| -- | information about the elaborated package that | ||
| -- is to be looked up that we want to add to the | ||
| -- information displayed in the advisory | ||
| type ElaboratedPackageInfoWith :: (Type -> Type) -> Type | ||
| data ElaboratedPackageInfoWith f = MkElaboratedPackageInfoWith | ||
| { elaboratedPackageVersion :: Version | ||
| -- ^ the version of the package that is installed | ||
| , packageAdvisories :: f [Advisory] | ||
| } | ||
| deriving stock (Generic) | ||
|
|
||
| deriving stock instance Eq (f [Advisory]) => (Eq (ElaboratedPackageInfoWith f)) | ||
|
|
||
| deriving stock instance Ord (f [Advisory]) => (Ord (ElaboratedPackageInfoWith f)) | ||
|
|
||
| deriving stock instance Show (f [Advisory]) => (Show (ElaboratedPackageInfoWith f)) | ||
|
|
||
| -- FUTUREWORK(mangoiv): this could probably be done more intelligent by also | ||
| -- looking up via the version range but I don't know exacty how | ||
|
|
||
| -- | 'Map' to lookup the package name in the install plan that returns information | ||
| -- about the package | ||
| installPlanToLookupTable :: ElaboratedInstallPlan -> Map PackageName ElaboratedPackageInfo | ||
| installPlanToLookupTable = Map.fromList . fmap planPkgToPackageInfo . Plan.toList | ||
| where | ||
| planPkgToPackageInfo pkg = do | ||
| let (PackageIdentifier {pkgName, pkgVersion}) = | ||
| foldPlanPackage | ||
| sourcePackageId | ||
| elabPkgSourceId | ||
| pkg | ||
| (pkgName, MkElaboratedPackageInfoWith {elaboratedPackageVersion = pkgVersion, packageAdvisories = Proxy}) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.