rework dep metadata with fallback

This commit is contained in:
Lucy Cifferello
2024-05-01 01:24:30 -04:00
parent 04da258d0e
commit 09132db249
2 changed files with 51 additions and 47 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 (..), PkgDependency (..))
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,
@@ -69,7 +67,6 @@ import Startlude (
readMaybe, readMaybe,
snd, snd,
sortOn, sortOn,
zipWith,
zipWithM, zipWithM,
($), ($),
(&&&), (&&&),
@@ -78,8 +75,7 @@ import Startlude (
(<$>), (<$>),
(<&>), (<&>),
(=<<), (=<<),
(>), (>)
show
) )
import UnliftIO (Concurrently (..), mapConcurrently) import UnliftIO (Concurrently (..), mapConcurrently)
import Yesod ( import Yesod (
@@ -90,7 +86,7 @@ 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 Data.List (head)
import Yesod (YesodRequest(reqGetParams)) import Yesod (YesodRequest(reqGetParams))
@@ -99,9 +95,9 @@ import Data.List (last)
import Data.Text (isPrefixOf) import Data.Text (isPrefixOf)
import Startlude (length) import Startlude (length)
import Control.Monad.Logger (logWarn) import Control.Monad.Logger (logWarn)
import Data.Bool (not) import Data.String.Interpolate.IsString (
import Data.List (null) i,
)
data PackageReq = PackageReq data PackageReq = PackageReq
{ packageReqId :: !PkgId { packageReqId :: !PkgId
, packageReqVersion :: !VersionRange , packageReqVersion :: !VersionRange
@@ -139,9 +135,9 @@ getPackageIndexR = do
limit' <- fromMaybe 20 <$> getLimitQuery limit' <- fromMaybe 20 <$> getLimitQuery
query <- T.strip . fromMaybe "" <$> lookupGetParam "query" query <- T.strip . fromMaybe "" <$> lookupGetParam "query"
let (source, packageRanges) = case pkgIds of let (source, packageRanges) = case pkgIds of
Nothing -> (serviceQuerySource category query pkgArch ram, const Any) Nothing -> (Database.Queries.serviceQuerySource category query pkgArch ram, const Any)
Just packages -> Just packages ->
let s = getPkgDataSource (packageReqId <$> packages) pkgArch ram let s = Database.Queries.getPkgDataSource (packageReqId <$> packages) pkgArch ram
r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages) r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages)
in (s, r) in (s, r)
filteredPackages <- filteredPackages <-
@@ -149,7 +145,7 @@ getPackageIndexR = do
runConduit $ runConduit $
source source
-- group conduit pipeline by pkg id -- group conduit pipeline by pkg id
.| collateVersions .| Database.Queries.collateVersions
-- filter out versions of apps that are incompatible with the OS predicate -- filter out versions of apps that are incompatible with the OS predicate
.| mapC (second (filter (osPredicate . versionRecordOsVersion . fst))) .| mapC (second (filter (osPredicate . versionRecordOsVersion . fst)))
-- filter hardware device compatability -- filter hardware device compatability
@@ -164,7 +160,7 @@ getPackageIndexR = do
-- grab the latest matching version if it exists -- grab the latest matching version if it exists
.| concatMapC (\(a, b) -> (a,b,) <$> (selectLatestVersionFromSpec packageRanges b)) .| concatMapC (\(a, b) -> (a,b,) <$> (selectLatestVersionFromSpec packageRanges b))
-- construct -- construct
.| mapMC (\(a, b, c) -> PackageMetadata a b (versionRecordNumber c) <$> getCategoriesFor a) .| mapMC (\(a, b, c) -> PackageMetadata a b (versionRecordNumber c) <$> Database.Queries.getCategoriesFor a)
-- pages start at 1 for some reason. TODO: make pages start at 0 -- pages start at 1 for some reason. TODO: make pages start at 0
.| (dropC (limit' * (page - 1)) *> takeC limit') .| (dropC (limit' * (page - 1)) *> takeC limit')
.| sinkList .| sinkList
@@ -219,16 +215,20 @@ getPackageDependencies ::
ReaderT SqlBackend m (HashMap PkgId DependencyRes) ReaderT SqlBackend m (HashMap PkgId DependencyRes)
getPackageDependencies PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} = getPackageDependencies PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} =
do do
pkgDepInfo' <- getPkgDependencyData pkg pkgVersion depPkgRecordEntities <- Database.Queries.getPkgDependencyData pkg pkgVersion
let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo' fmap HM.fromList $
pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo) for depPkgRecordEntities $ \(pr) -> do
let depMetadata = zipWith formatDependencyInfo pkgDepInfo $ filter (not . null) pkgDepInfoWithVersions let depId = unPkgRecordKey $ entityKey pr
lift $ let depPkgRecord = entityVal pr
fmap HM.fromList $ mVersionRecord <- Database.Queries.getLatestVersionRecord $ entityKey pr
for depMetadata $ \(depId, title, v, isLocal) -> do case mVersionRecord of
icon <- loadIcon depId v Just VersionRecord{..} -> do
pure $ (depId, DependencyRes title icon isLocal) 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}. 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) =>
@@ -295,13 +295,4 @@ selectDependencyBestVersion osPredicate pkgDepInfo depVersions = do
Just bestVersion -> (pkgId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal) Just bestVersion -> (pkgId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal)
-- use latest version of dep for metadata info -- use latest version of dep for metadata info
Nothing -> (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal) Nothing -> (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)
else (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal) else (pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)
formatDependencyInfo :: (PkgDependency, PkgRecord) -> [VersionRecord] -> (PkgId, Text, Version, Bool)
formatDependencyInfo pkgDepInfo depVersions = do
let pkgDepRecord = fst pkgDepInfo
let isLocal = pkgRecordHidden $ snd pkgDepInfo
let depId = pkgDependencyDepId pkgDepRecord
let pkgId = unPkgRecordKey depId
let latestDepVersion = head $ sortOn (Down . versionRecordNumber) depVersions
(pkgId, versionRecordTitle latestDepVersion, versionRecordNumber latestDepVersion, isLocal)