further case fixes for empty list bug (#143)

* log

* fix empty case

* cleanup

* log

* simplify getting dep metadata

* cleanup

* log

* filter empty lists

* rework dep metadata with fallback

* update log

* cleanup

* cleanup
This commit is contained in:
Lucy
2024-05-01 14:40:45 -04:00
committed by GitHub
parent 4b7034a9c6
commit a2d42498a9
3 changed files with 51 additions and 58 deletions

View File

@@ -19,7 +19,7 @@ import Model (
Metric (Metric), Metric (Metric),
PkgDependency (..), PkgDependency (..),
PkgRecord (PkgRecord), PkgRecord (PkgRecord),
VersionRecord (VersionRecord), VersionPlatform (VersionPlatform), EntityField (VersionPlatformPkgId, VersionPlatformVersionNumber, VersionPlatformArch, AdminPkgsPkgId, AdminPkgsAdmin), PkgRecordId, AdminPkgs, AdminId, VersionRecord (VersionRecord), VersionPlatform (VersionPlatform), EntityField (VersionPlatformPkgId, VersionPlatformVersionNumber, VersionPlatformArch, AdminPkgsPkgId, AdminPkgsAdmin, PkgDependencyDepId), PkgRecordId, AdminPkgs, AdminId,
) )
import Orphans.Emver () import Orphans.Emver ()
import Startlude ( import Startlude (
@@ -73,6 +73,9 @@ import Database.Esqueleto.Experimental (
(==.), (==.),
(^.), (^.),
(||.), (||.),
isNothing,
(<=.),
limit
) )
import Database.Persist qualified as P import Database.Persist qualified as P
import Database.Persist.Postgresql ( import Database.Persist.Postgresql (
@@ -96,7 +99,7 @@ import Model (
VersionRecordNumber, VersionRecordNumber,
VersionRecordPkgId, VersionRecordPkgId,
VersionRecordTitle, VersionRecordTitle,
VersionRecordUpdatedAt, PkgRecordHidden, VersionPlatformRam, PkgRecordUpdatedAt VersionRecordUpdatedAt, PkgRecordHidden, VersionPlatformRam, PkgRecordUpdatedAt, VersionRecordCreatedAt
), ),
Key (unPkgRecordKey), Key (unPkgRecordKey),
PkgCategory, PkgCategory,
@@ -113,10 +116,8 @@ import Startlude (
snd, snd,
sortOn, sortOn,
($>), ($>),
(<$>), Int, (<$>), Int, listToMaybe,
) )
import Database.Esqueleto.Experimental (isNothing)
import Database.Esqueleto.Experimental ((<=.))
serviceQuerySource :: serviceQuerySource ::
(MonadResource m, MonadIO m) => (MonadResource m, MonadIO m) =>
@@ -182,16 +183,15 @@ getPkgDependencyData ::
MonadIO m => MonadIO m =>
PkgId -> PkgId ->
Version -> Version ->
ReaderT SqlBackend m [(P.Entity PkgDependency, P.Entity PkgRecord)] ReaderT SqlBackend m [P.Entity PkgRecord]
getPkgDependencyData pkgId pkgVersion = getPkgDependencyData pkgId pkgVersion =
select $ select $
from $ do from $ do
(pkgDepRecord :& pr) <- from $ table @PkgDependency (pkgDepRecord :& pr) <- from $ table @PkgDependency
`innerJoin` table @PkgRecord `on` (\(v :& p) -> (PkgRecordId === PkgDependencyPkgId) (p :& v)) `innerJoin` table @PkgRecord `on` (\(pd :& pr) -> (PkgRecordId === PkgDependencyDepId) (pr :& pd))
where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val (PkgRecordKey pkgId)) where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val (PkgRecordKey pkgId))
where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion) where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion)
pure (pkgDepRecord, pr) pure pr
(===) :: (===) ::
(PersistEntity val1, PersistEntity val2, P.PersistField typ) => (PersistEntity val1, PersistEntity val2, P.PersistField typ) =>
@@ -201,6 +201,19 @@ getPkgDependencyData pkgId pkgVersion =
SqlExpr (Value Bool) SqlExpr (Value Bool)
(===) a' b' (a :& b) = a ^. a' ==. b ^. b' (===) a' b' (a :& b) = a ^. a' ==. b ^. b'
getLatestVersionRecord ::
MonadIO m =>
Key PkgRecord ->
ReaderT SqlBackend m (Maybe VersionRecord)
getLatestVersionRecord pkgId = do
vrs <- select $ do
v <- from $ table @VersionRecord
where_ $ v ^. VersionRecordPkgId ==. val pkgId
orderBy [desc (v ^. VersionRecordCreatedAt)]
limit 1
pure v
pure $ entityVal <$> listToMaybe vrs
getCategoriesFor :: getCategoriesFor ::
MonadUnliftIO m => MonadUnliftIO m =>

View File

@@ -21,19 +21,18 @@ import Database.Persist.Sql (SqlBackend)
import Database.Queries ( import Database.Queries (
collateVersions, collateVersions,
getCategoriesFor, getCategoriesFor,
getDependencyVersions,
getPkgDataSource, getPkgDataSource,
getPkgDependencyData, getPkgDependencyData,
serviceQuerySource, serviceQuerySource, getLatestVersionRecord,
) )
import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings)) import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings))
import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..)) import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..))
import Handler.Types.Api (ApiVersion (..)) import Handler.Types.Api (ApiVersion (..))
import Handler.Util (basicRender, parseQueryParam, filterDeprecatedVersions, filterDevices, getPkgArch) import Handler.Util (basicRender, parseQueryParam, filterDeprecatedVersions, filterDevices, getPkgArch)
import Lib.PkgRepository (PkgRepo, getIcon, getManifest) import Lib.PkgRepository (PkgRepo, getIcon, getManifest)
import Lib.Types.Core (PkgId) import Lib.Types.Core (PkgId, PkgId(PkgId))
import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||)) import Lib.Types.Emver (Version, Version(Version), VersionRange (..), parseRange, satisfies)
import Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..), PkgRecord (pkgRecordHidden)) import Model (Category (..), Key (..), VersionRecord (..), PkgRecord (..))
import Protolude.Unsafe (unsafeFromJust) import Protolude.Unsafe (unsafeFromJust)
import Settings (AppSettings (communityVersion)) import Settings (AppSettings (communityVersion))
import Startlude ( import Startlude (
@@ -51,7 +50,6 @@ import Startlude (
Num ((*), (-)), Num ((*), (-)),
Show, Show,
Text, Text,
Traversable (traverse),
const, const,
encodeUtf8, encodeUtf8,
filter, filter,
@@ -62,14 +60,12 @@ import Startlude (
id, id,
liftA2, liftA2,
mappend, mappend,
maximumOn,
nonEmpty, nonEmpty,
note, note,
pure, pure,
readMaybe, readMaybe,
snd, snd,
sortOn, sortOn,
zipWith,
zipWithM, zipWithM,
($), ($),
(&&&), (&&&),
@@ -77,8 +73,7 @@ import Startlude (
(.*), (.*),
(<$>), (<$>),
(<&>), (<&>),
(=<<), (=<<)
(>)
) )
import UnliftIO (Concurrently (..), mapConcurrently) import UnliftIO (Concurrently (..), mapConcurrently)
import Yesod ( import Yesod (
@@ -89,15 +84,16 @@ import Yesod (
lookupGetParam, lookupGetParam,
) )
import Data.Tuple (fst) import Data.Tuple (fst)
import Database.Persist.Postgresql (entityVal) import Database.Persist.Postgresql (entityVal, entityKey)
import Yesod.Core (getsYesod) import Yesod.Core (getsYesod)
import Data.List (head)
import Yesod (YesodRequest(reqGetParams)) import Yesod (YesodRequest(reqGetParams))
import Yesod (getRequest) import Yesod (getRequest)
import Data.List (last) import Data.List (last)
import Data.Text (isPrefixOf) import Data.Text (isPrefixOf)
import Startlude (length) import Control.Monad.Logger (logWarn)
import Data.String.Interpolate.IsString (
i,
)
data PackageReq = PackageReq data PackageReq = PackageReq
{ packageReqId :: !PkgId { packageReqId :: !PkgId
, packageReqVersion :: !VersionRange , packageReqVersion :: !VersionRange
@@ -166,7 +162,7 @@ getPackageIndexR = do
.| sinkList .| sinkList
-- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list -- NOTE: if a package's dependencies do not meet the system requirements, it is currently omitted from the list
pkgsWithDependencies <- runDB $ mapConcurrently (getPackageDependencies osPredicate) filteredPackages pkgsWithDependencies <- runDB $ mapConcurrently getPackageDependencies filteredPackages
PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies) PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies)
getPkgIdsQuery :: Handler (Maybe [PackageReq]) getPkgIdsQuery :: Handler (Maybe [PackageReq])
@@ -211,21 +207,24 @@ getRamQuery = parseQueryParam "hardware.ram" ((flip $ note . mappend "Invalid 'r
getPackageDependencies :: getPackageDependencies ::
(MonadIO m, MonadLogger m, MonadResource m, Has PkgRepo r, MonadReader r m) => (MonadIO m, MonadLogger m, MonadResource m, Has PkgRepo r, MonadReader r m) =>
(Version -> Bool) ->
PackageMetadata -> PackageMetadata ->
ReaderT SqlBackend m (HashMap PkgId DependencyRes) ReaderT SqlBackend m (HashMap PkgId DependencyRes)
getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} = getPackageDependencies PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} =
do do
pkgDepInfo' <- getPkgDependencyData pkg pkgVersion depPkgRecordEntities <- getPkgDependencyData pkg pkgVersion
let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo'
pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo)
let depMetadata = zipWith (selectDependencyBestVersion osPredicate) pkgDepInfo pkgDepInfoWithVersions
lift $
fmap HM.fromList $ fmap HM.fromList $
for depMetadata $ \(depId, title, v, isLocal) -> do for depPkgRecordEntities $ \(pr) -> do
icon <- loadIcon depId v let depId = unPkgRecordKey $ entityKey pr
pure $ (depId, DependencyRes title icon isLocal) let depPkgRecord = entityVal pr
mVersionRecord <- getLatestVersionRecord $ entityKey pr
case mVersionRecord of
Just VersionRecord{..} -> do
icon <- lift $ loadIcon depId versionRecordNumber
pure $ (depId, DependencyRes versionRecordTitle icon $ pkgRecordHidden depPkgRecord)
Nothing -> do
$logWarn [i|No latest version record found for #{depId} while getting dependency metadata for #{pkg}@#{pkgVersion}. Using fallback package.|]
icon <- lift $ loadIcon (PkgId "fallback") $ Version(1,0,0,0)
pure $ (depId, DependencyRes "Unknown" icon $ pkgRecordHidden depPkgRecord)
constructPackageListApiRes :: constructPackageListApiRes ::
(MonadResource m, MonadReader r m, Has AppSettings r, Has PkgRepo r) => (MonadResource m, MonadReader r m, Has AppSettings r, Has PkgRepo r) =>
@@ -273,23 +272,3 @@ selectLatestVersionFromSpec pkgRanges vs =
let pkgId = NE.head $ versionRecordPkgId <$> vs let pkgId = NE.head $ versionRecordPkgId <$> vs
spec = pkgRanges (unPkgRecordKey pkgId) spec = pkgRanges (unPkgRecordKey pkgId)
in headMay . sortOn (Down . versionRecordNumber) $ NE.filter ((`satisfies` spec) . versionRecordNumber) vs in headMay . sortOn (Down . versionRecordNumber) $ NE.filter ((`satisfies` spec) . versionRecordNumber) vs
-- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package)
selectDependencyBestVersion :: (Version -> Bool) -> (PkgDependency, PkgRecord) -> [VersionRecord] -> (PkgId, Text, Version, Bool)
selectDependencyBestVersion osPredicate pkgDepInfo depVersions = do
let pkgDepRecord = fst pkgDepInfo
let isLocal = pkgRecordHidden $ snd pkgDepInfo
let depId = pkgDependencyDepId pkgDepRecord
let pkgId = unPkgRecordKey depId
let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord
let latestDepVersion = head $ sortOn (Down . versionRecordNumber) depVersions
let compatiblePkgDepInfo = (filter (osPredicate . versionRecordOsVersion)) depVersions
if (length compatiblePkgDepInfo > 0)
then do
let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) compatiblePkgDepInfo
case maximumOn versionRecordNumber satisfactory of
Just bestVersion -> (pkgId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal)
-- use latest version of dep for metadata info
Nothing -> (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)
else (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)

View File

@@ -101,6 +101,7 @@ import Settings (AppSettings(whitelist))
import Network.HTTP.Types (status200) import Network.HTTP.Types (status200)
import Database.Persist (insert_) import Database.Persist (insert_)
import Yesod (lookupPostParam) import Yesod (lookupPostParam)
import Data.Maybe (isNothing)
orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a
orThrow action other = orThrow action other =
@@ -240,7 +241,7 @@ getPkgArch = do
filterDeprecatedVersions :: Version -> (Version -> Bool) -> [VersionRecord] -> [VersionRecord] filterDeprecatedVersions :: Version -> (Version -> Bool) -> [VersionRecord] -> [VersionRecord]
filterDeprecatedVersions communityVersion osPredicate vrs = do filterDeprecatedVersions communityVersion osPredicate vrs = do
if (osPredicate communityVersion) if (osPredicate communityVersion)
then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ vrs then filter (\v -> isNothing $ versionRecordDeprecatedAt v) $ vrs
else vrs else vrs
filterDevices :: (MonadUnliftIO m) => (MM.MultiMap Text Text) -> [(VersionRecord, VersionPlatform)] -> m [VersionRecord] filterDevices :: (MonadUnliftIO m) => (MM.MultiMap Text Text) -> [(VersionRecord, VersionPlatform)] -> m [VersionRecord]