mirror of
https://github.com/Start9Labs/registry.git
synced 2026-03-26 02:11:53 +00:00
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:
@@ -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 =>
|
||||||
|
|||||||
@@ -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)
|
|
||||||
@@ -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]
|
||||||
|
|||||||
Reference in New Issue
Block a user