Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

Feat/local packages (#133)

Browse Source 
* enable packages to be marked as unavailable locally

* change isLocal column to hidden

* add option to deprecate a service version based on a min os version
This commit is contained in:
Lucy C
2023-04-11 19:08:53 -06:00
committed by GitHub
parent 4d6db96c0c
commit 35500cfc02
10 changed files with 78 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
src/Database/Queries.hs
View File

@@ -31,7 +31,7 @@ import Startlude (
getCurrentTime,
maybe,
($),
(.),
(.), Bool (False),
)
import System.FilePath (takeExtension)
import UnliftIO (
@@ -97,7 +97,7 @@ import Model (
VersionRecordNumber,
VersionRecordPkgId,
VersionRecordTitle,
VersionRecordUpdatedAt
VersionRecordUpdatedAt, PkgRecordHidden
),
Key (unPkgRecordKey),
PkgCategory,
@@ -105,7 +105,6 @@ import Model (
)
import Startlude (
Applicative (pure),
Bool,
Down (Down),
Eq ((==)),
Functor (fmap),
@@ -118,7 +117,6 @@ import Startlude (
(<$>),
)
serviceQuerySource ::
(MonadResource m, MonadIO m) =>
Maybe Text ->
@@ -130,24 +128,28 @@ serviceQuerySource mCat query mOsArch = selectSource $ do
Just osArch -> do
service <- case mCat of
Nothing -> do
(service :& vp) <- from $ table @VersionRecord
(service :& vp :& pr) <- from $ table @VersionRecord
`innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service))
`innerJoin` table @PkgRecord `on` (\(v :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v))
where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
where_ (vp ^. VersionPlatformArch ==. val osArch)
where_ (pr ^. PkgRecordHidden ==. val False)
where_ $ queryInMetadata query service
pure service
Just category -> do
(service :& _ :& cat :& vp) <-
(service :& _ :& cat :& vp :& pr) <-
from $
table @VersionRecord
`innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId)
`innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b))
`innerJoin` table @VersionPlatform `on` (\(service :& _ :& _ :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service))
`innerJoin` table @PkgRecord `on` (\(v :& _ :& _ :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v))
-- if there is a cateogry, only search in category
-- weight title, short, long (bitcoin should equal Bitcoin Core)
where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service
where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
where_ (vp ^. VersionPlatformArch ==. val osArch)
where_ (pr ^. PkgRecordHidden ==. val False)
pure service
groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber)
orderBy
@@ -159,18 +161,22 @@ serviceQuerySource mCat query mOsArch = selectSource $ do
Nothing -> do
service <- case mCat of
Nothing -> do
service <- from $ table @VersionRecord
(service :& pr) <- from $ table @VersionRecord
`innerJoin` table @PkgRecord `on` (\(v :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v))
where_ $ queryInMetadata query service
where_ (pr ^. PkgRecordHidden ==. val False)
pure service
Just category -> do
(service :& _ :& cat) <-
(service :& _ :& cat :& pr) <-
from $
table @VersionRecord
`innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId)
`innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b))
`innerJoin` table @PkgRecord `on` (\(v :& _ :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v))
-- if there is a cateogry, only search in category
-- weight title, short, long (bitcoin should equal Bitcoin Core)
where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service
where_ (pr ^. PkgRecordHidden ==. val False)
pure service
groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber)
orderBy
@@ -207,14 +213,15 @@ getPkgDependencyData ::
MonadIO m =>
PkgId ->
Version ->
ReaderT SqlBackend m [PkgDependency]
getPkgDependencyData pkgId pkgVersion = fmap (fmap entityVal) $
ReaderT SqlBackend m [(P.Entity PkgDependency, P.Entity PkgRecord)]
getPkgDependencyData pkgId pkgVersion =
select $
from $ do
pkgDepRecord <- from $ table @PkgDependency
(pkgDepRecord :& pr) <- from $ table @PkgDependency
`innerJoin` table @PkgRecord `on` (\(v :& p) -> (PkgRecordId === PkgDependencyPkgId) (p :& v))
where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val (PkgRecordKey pkgId))
where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion)
pure pkgDepRecord
pure (pkgDepRecord, pr)
(===) ::
@@ -307,6 +314,7 @@ upsertPackageVersion PackageManifest{..} = do
VersionRecord
now
(Just now)
Nothing
pkgId
packageManifestVersion
packageManifestTitle
@@ -315,7 +323,7 @@ upsertPackageVersion PackageManifest{..} = do
iconType
packageManifestReleaseNotes
packageManifestEosVersion
_res <- try @_ @SomeException $ insertKey pkgId (PkgRecord now (Just now))
_res <- try @_ @SomeException $ insertKey pkgId (PkgRecord False now (Just now))
repsert (VersionRecordKey pkgId packageManifestVersion) ins
upsertPackageVersionPlatform :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m ()

4
src/Handler/Eos/V0/Latest.hs
View File

@@ -26,7 +26,7 @@ import Orphans.Emver ()
import Startlude (Down (..), Eq, Generic, Maybe (..), Ord ((<)), Show, Text, filter, fst, head, pure, sortOn, ($), (&&&), (.), (<$>), (<&>), (<=))
import Yesod (ToContent (toContent), ToTypedContent (..), YesodPersist (runDB), getsYesod)
import Yesod.Core.Types (JSONResponse (..))
import Settings (AppSettings(maxEosVersion))
import Settings (AppSettings(maxOsVersion))
import Lib.Types.Core (OsArch(RASPBERRYPI))
import Data.Maybe (fromMaybe)
@@ -50,7 +50,7 @@ getEosVersionR :: Handler (JSONResponse (Maybe EosRes))
getEosVersionR = do
currentEosVersion <- fromMaybe Version { unVersion = (0,3,0,0) } <$> queryParamAs "eos-version" parseVersion
arch <- fromMaybe RASPBERRYPI <$> getArchQuery
maxVersion <- getsYesod $ maxEosVersion . appSettings
maxVersion <- getsYesod $ maxOsVersion . appSettings
allEosVersions <- runDB $
select $ do
vers <- from $ table @OsVersion

6
src/Handler/Package/Api.hs
View File

@@ -17,6 +17,7 @@ import Startlude (
ByteString,
Eq,
Generic,
Bool,
NonEmpty,
Show,
Text,
@@ -76,10 +77,11 @@ instance ApiResponse PackageRes where
data DependencyRes = DependencyRes
{ dependencyResTitle :: !Text
, dependencyResIcon :: !(ContentType, ByteString)
, dependencyResHidden :: !Bool
}
deriving (Eq, Show)
instance ApiResponse DependencyRes where
apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle]
apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle]
apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle, "hidden" .= dependencyResHidden]
apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle, "hidden" .= dependencyResHidden]

13
src/Handler/Package/V0/Latest.hs
View File

@@ -9,16 +9,18 @@ import Data.List (lookup)
import Data.List.NonEmpty.Extra qualified as NE
import Data.Tuple.Extra (second)
import Database.Queries (collateVersions, getPkgDataSource)
import Foundation (Handler)
import Foundation (Handler, RegistryCtx (appSettings))
import Handler.Package.V1.Index (getOsVersionQuery)
import Lib.Error (S9Error (..))
import Lib.Types.Core (PkgId)
import Lib.Types.Emver (Version, satisfies)
import Lib.Types.Emver (Version (..), satisfies)
import Model (VersionRecord (..))
import Network.HTTP.Types (status400)
import Startlude (Bool (True), Down (Down), Either (..), Generic, Maybe (..), NonEmpty, Show, const, encodeUtf8, filter, flip, nonEmpty, pure, ($), (.), (<$>), (<&>))
import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)
import Handler.Util (getArchQuery)
import Handler.Util (getArchQuery, filterDeprecatedVersions)
import Yesod.Core (getsYesod)
import Settings (AppSettings(minOsVersion))
newtype VersionLatestRes = VersionLatestRes (HashMap PkgId (Maybe Version))
@@ -38,6 +40,7 @@ getVersionLatestR = do
Nothing -> const True
Just v -> flip satisfies v
osArch <- getArchQuery
minOsVersion <- getsYesod $ minOsVersion . appSettings
do
case lookup "ids" getParameters of
Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "<MISSING>")
@@ -54,6 +57,8 @@ getVersionLatestR = do
.| collateVersions
-- filter out versions of apps that are incompatible with the OS predicate
.| mapC (second (filter (osPredicate' . versionRecordOsVersion)))
-- filter out deprecated service versions after a min os version
.| mapC (second (filterDeprecatedVersions minOsVersion osPredicate'))
-- prune empty version sets
.| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
-- grab the latest matching version if it exists
@@ -65,4 +70,4 @@ getVersionLatestR = do
HM.union (HM.fromList $ filteredPackages) (HM.fromList packageList)
where
selectLatestVersion :: NonEmpty VersionRecord -> Version
selectLatestVersion vs = NE.head $ (versionRecordNumber <$>) $ NE.sortOn (Down . versionRecordNumber) $ vs
selectLatestVersion vs = NE.head $ (versionRecordNumber <$>) $ NE.sortOn (Down . versionRecordNumber) $ vs

33
src/Handler/Package/V1/Index.hs
View File

@@ -25,16 +25,16 @@ import Database.Queries (
getPkgDependencyData,
serviceQuerySource,
)
import Foundation (Handler, Route (InstructionsR, LicenseR))
import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings))
import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..))
import Handler.Types.Api (ApiVersion (..))
import Handler.Util (basicRender, parseQueryParam, getArchQuery)
import Handler.Util (basicRender, parseQueryParam, getArchQuery, filterDeprecatedVersions)
import Lib.PkgRepository (PkgRepo, getIcon, getManifest)
import Lib.Types.Core (PkgId)
import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||))
import Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..))
import Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..), PkgRecord (pkgRecordHidden))
import Protolude.Unsafe (unsafeFromJust)
import Settings (AppSettings)
import Settings (AppSettings (minOsVersion))
import Startlude (
Applicative ((*>)),
Bifunctor (..),
@@ -87,6 +87,9 @@ import Yesod (
YesodPersist (runDB),
lookupGetParam,
)
import Data.Tuple (fst)
import Database.Persist.Postgresql (entityVal)
import Yesod.Core (getsYesod)
data PackageReq = PackageReq
{ packageReqId :: !PkgId
@@ -115,7 +118,8 @@ getPackageIndexR = do
getOsVersionQuery <&> \case
Nothing -> const True
Just v -> flip satisfies v
osArch <- getArchQuery
osArch <- getArchQuery
minOsVersion <- getsYesod $ minOsVersion . appSettings
do
pkgIds <- getPkgIdsQuery
category <- getCategoryQuery
@@ -136,6 +140,8 @@ getPackageIndexR = do
.| collateVersions
-- filter out versions of apps that are incompatible with the OS predicate
.| mapC (second (filter (osPredicate . versionRecordOsVersion)))
-- filter out deprecated service versions after a min os version
.| mapC (second (filterDeprecatedVersions minOsVersion osPredicate))
-- prune empty version sets
.| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
-- grab the latest matching version if it exists
@@ -177,15 +183,16 @@ getPackageDependencies ::
ReaderT SqlBackend m (HashMap PkgId DependencyRes)
getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} =
do
pkgDepInfo <- getPkgDependencyData pkg pkgVersion
pkgDepInfoWithVersions <- traverse getDependencyVersions pkgDepInfo
pkgDepInfo' <- getPkgDependencyData pkg pkgVersion
let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo'
pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo)
let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions
let depMetadata = catMaybes $ zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo
lift $
fmap HM.fromList $
for depMetadata $ \(depId, title, v) -> do
for depMetadata $ \(depId, title, v, isLocal) -> do
icon <- loadIcon depId v
pure $ (depId, DependencyRes title icon)
pure $ (depId, DependencyRes title icon isLocal)
constructPackageListApiRes ::
@@ -237,11 +244,13 @@ selectLatestVersionFromSpec pkgRanges 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 :: PkgDependency -> [VersionRecord] -> Maybe (PkgId, Text, Version)
selectDependencyBestVersion pkgDepRecord depVersions = do
selectDependencyBestVersion :: (PkgDependency, PkgRecord) -> [VersionRecord] -> Maybe (PkgId, Text, Version, Bool)
selectDependencyBestVersion pkgDepInfo depVersions = do
let pkgDepRecord = fst pkgDepInfo
let isLocal = pkgRecordHidden $ snd pkgDepInfo
let depId = pkgDependencyDepId pkgDepRecord
let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord
let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions
case maximumOn versionRecordNumber satisfactory of
Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion)
Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal)
Nothing -> Nothing

13
src/Handler/Util.hs
View File

@@ -25,13 +25,13 @@ import Lib.PkgRepository (
)
import Lib.Types.Core (PkgId, OsArch)
import Lib.Types.Emver (
Version,
Version (Version, unVersion),
VersionRange,
satisfies, parseVersion
)
import Model (
UserActivity (..),
VersionRecord (versionRecordOsVersion),
VersionRecord (versionRecordOsVersion, versionRecordDeprecatedAt),
)
import Network.HTTP.Types (
Status,
@@ -79,6 +79,7 @@ import Yesod (
)
import Yesod.Core (addHeader, logWarn)
import Lib.Error (S9Error (..))
import Data.Maybe (isJust)
orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a
orThrow action other =
@@ -174,4 +175,10 @@ fetchCompatiblePkgVersions osVersion pkg = do
Just v -> flip satisfies v
getArchQuery :: Handler (Maybe OsArch)
getArchQuery = parseQueryParam "arch" ((flip $ note . mappend "Invalid 'arch': ") =<< readMaybe)
getArchQuery = parseQueryParam "arch" ((flip $ note . mappend "Invalid 'arch': ") =<< readMaybe)
filterDeprecatedVersions :: Version -> (Version -> Bool) -> [VersionRecord] -> [VersionRecord]
filterDeprecatedVersions minOsVersion osPredicate vrs = do
if (osPredicate minOsVersion)
then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ vrs
else vrs

4
src/Lib/PkgRepository.hs
View File

@@ -206,7 +206,7 @@ loadPkgDependencies appConnPool manifest = do
time <- liftIO getCurrentTime
_ <-
runWith appConnPool $
insertKey (PkgRecordKey pkgId) (PkgRecord time Nothing) `catch` \(e :: SqlError) ->
insertKey (PkgRecordKey pkgId) (PkgRecord False time Nothing) `catch` \(e :: SqlError) ->
-- 23505 is "already exists"
if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e
let deps' = first PkgRecordKey <$> HM.toList deps
@@ -215,7 +215,7 @@ loadPkgDependencies appConnPool manifest = do
( \d -> flip runSqlPool appConnPool $ do
_ <-
runWith appConnPool $
insertKey (fst d) (PkgRecord time Nothing) `catch` \(e :: SqlError) ->
insertKey (fst d) (PkgRecord False time Nothing) `catch` \(e :: SqlError) ->
-- 23505 is "already exists"
if sqlState e == "23505" then update (fst d) [PkgRecordUpdatedAt =. Just time] else throwIO e
insertUnique $

3
src/Model.hs
View File

@@ -36,6 +36,7 @@ import Startlude (
Text,
UTCTime,
Word32,
Bool
)
@@ -44,6 +45,7 @@ share
[persistLowerCase|
PkgRecord
Id PkgId sql=pkg_id
hidden Bool default=False
createdAt UTCTime
updatedAt UTCTime Maybe
deriving Eq
@@ -52,6 +54,7 @@ PkgRecord
VersionRecord sql=version
createdAt UTCTime
updatedAt UTCTime Maybe
deprecatedAt UTCTime Maybe
pkgId PkgRecordId
number Version
title Text

6
src/Settings.hs
View File

@@ -75,7 +75,8 @@ data AppSettings = AppSettings
-- ^ Should all log messages be displayed?
, errorLogRoot :: !FilePath
, marketplaceName :: !Text
, maxEosVersion :: !Version
, maxOsVersion :: !Version
, minOsVersion :: !Version
, registryHostname :: !Text
, registryVersion :: !Version
, resourcesDir :: !FilePath
@@ -110,7 +111,8 @@ instance FromJSON AppSettings where
appShouldLogAll <- o .:? "should-log-all" .!= False
errorLogRoot <- o .: "error-log-root"
marketplaceName <- o .: "marketplace-name"
maxEosVersion <- o .: "max-eos-version"
maxOsVersion <- o .: "max-eos-version"
minOsVersion <- o .: "min-eos-version"
registryHostname <- o .: "registry-hostname"
resourcesDir <- o .: "resources-path"
needsMigration <- o .: "run-migration"