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

fixes

Browse Source
This commit is contained in:
Lucy Cifferello
2023-07-23 16:16:20 -04:00
parent 5c1720aad8
commit 0cf26f55b3
7 changed files with 98 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
resources/apps/lnd/0.13.3.1/manifest.json
View File

@@ -16,6 +16,13 @@
"build": [ "build": [
"make" "make"
], ],
"hardware-requirements" {
"device": {
"processor": "intel",
"display": "r'^{.*}$'"
},
"ram": "8"
}
"release-notes": "Upgrade to EmbassyOS v0.3.0", "release-notes": "Upgrade to EmbassyOS v0.3.0",
"license": "mit", "license": "mit",
"wrapper-repo": "https://github.com/Start9Labs/lnd-wrapper", "wrapper-repo": "https://github.com/Start9Labs/lnd-wrapper",

18
src/Database/Queries.hs
View File

@@ -122,17 +122,17 @@ serviceQuerySource ::
(MonadResource m, MonadIO m) => (MonadResource m, MonadIO m) =>
Maybe Text -> Maybe Text ->
Text -> Text ->
Maybe OsArch -> [OsArch] ->
Maybe Int -> Maybe Int ->
ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) () ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
serviceQuerySource mCat query mOsArch mRam = selectSource $ do serviceQuerySource mCat query arches mRam = selectSource $ do
service <- case mCat of service <- case mCat of
Nothing -> do Nothing -> do
(service :& vp :& pr) <- from $ table @VersionRecord (service :& vp :& pr) <- from $ table @VersionRecord
`innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service)) `innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service))
`innerJoin` table @PkgRecord `on` (\(v :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) `innerJoin` table @PkgRecord `on` (\(v :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v))
where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
where_ (vp ^. VersionPlatformArch ==. val mOsArch) where_ (vp ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
where_ (vp ^. VersionPlatformRam ==. val mRam) where_ (vp ^. VersionPlatformRam ==. val mRam)
where_ (pr ^. PkgRecordHidden ==. val False) where_ (pr ^. PkgRecordHidden ==. val False)
where_ $ queryInMetadata query service where_ $ queryInMetadata query service
@@ -149,7 +149,7 @@ serviceQuerySource mCat query mOsArch mRam = selectSource $ do
-- weight title, short, long (bitcoin should equal Bitcoin Core) -- weight title, short, long (bitcoin should equal Bitcoin Core)
where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service
where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
where_ (vp ^. VersionPlatformArch ==. val mOsArch) where_ (vp ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
where_ (vp ^. VersionPlatformRam >. val mRam) where_ (vp ^. VersionPlatformRam >. val mRam)
where_ (pr ^. PkgRecordHidden ==. val False) where_ (pr ^. PkgRecordHidden ==. val False)
pure service pure service
@@ -168,12 +168,12 @@ queryInMetadata query service =
||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%)) ||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%))
getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> Maybe OsArch -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) () getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> [OsArch] -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
getPkgDataSource pkgs mOsArch = selectSource $ do getPkgDataSource pkgs arches = selectSource $ do
(pkgData :& vp) <- from $ table @VersionRecord (pkgData :& vp) <- from $ table @VersionRecord
`innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service)) `innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service))
where_ (pkgData ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) where_ (pkgData ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
where_ (vp ^. VersionPlatformArch ==. val mOsArch) where_ (vp ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
where_ (pkgData ^. VersionRecordPkgId `in_` valList (PkgRecordKey <$> pkgs)) where_ (pkgData ^. VersionRecordPkgId `in_` valList (PkgRecordKey <$> pkgs))
pure pkgData pure pkgData
@@ -317,12 +317,12 @@ upsertPackageVersionPlatform maybeArches PackageManifest{..} = do
getVersionPlatform :: getVersionPlatform ::
(Monad m, MonadIO m) => (Monad m, MonadIO m) =>
PkgRecordId -> PkgRecordId ->
[Maybe OsArch] -> [OsArch] ->
ReaderT SqlBackend m [VersionPlatform] ReaderT SqlBackend m [VersionPlatform]
getVersionPlatform pkgId arches = do getVersionPlatform pkgId arches = do
vps <- select $ do vps <- select $ do
v <- from $ table @VersionPlatform v <- from $ table @VersionPlatform
where_ $ v ^. VersionPlatformPkgId ==. val pkgId where_ $ v ^. VersionPlatformPkgId ==. val pkgId
where_ (v ^. VersionPlatformArch `in_` valList arches) where_ (v ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
pure v pure v
pure $ entityVal <$> vps pure $ entityVal <$> vps

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

@@ -16,9 +16,9 @@ import Lib.Types.Core (PkgId)
import Lib.Types.Emver (Version (..), satisfies) import Lib.Types.Emver (Version (..), satisfies)
import Model (VersionRecord (..)) import Model (VersionRecord (..))
import Network.HTTP.Types (status400) import Network.HTTP.Types (status400)
import Startlude (Bool (True), Down (Down), Either (..), Generic, Maybe (..), NonEmpty, Show, const, encodeUtf8, filter, flip, nonEmpty, pure, ($), (.), (<$>), (<&>)) 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 Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)
import Handler.Util (getOsArch, filterDeprecatedVersions) import Handler.Util (filterDeprecatedVersions, getPkgArch)
import Yesod.Core (getsYesod) import Yesod.Core (getsYesod)
import Settings (AppSettings(communityVersion)) import Settings (AppSettings(communityVersion))
@@ -39,7 +39,9 @@ getVersionLatestR = do
getOsVersionCompat <&> \case getOsVersionCompat <&> \case
Nothing -> const True Nothing -> const True
Just v -> flip satisfies v Just v -> flip satisfies v
osArch <- getOsArch pkgArch <- getPkgArch >>= \case
Nothing -> pure []
Just a -> pure a
communityServiceDeprecationVersion <- getsYesod $ communityVersion . appSettings communityServiceDeprecationVersion <- getsYesod $ communityVersion . appSettings
do do
case lookup "ids" getParameters of case lookup "ids" getParameters of
@@ -48,7 +50,7 @@ getVersionLatestR = do
Left _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages) Left _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages)
Right p -> do Right p -> do
let packageList = (,Nothing) <$> p let packageList = (,Nothing) <$> p
let source = getPkgDataSource p osArch let source = getPkgDataSource p pkgArch
filteredPackages <- filteredPackages <-
runDB $ runDB $
runConduit $ runConduit $

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

@@ -28,7 +28,7 @@ import Database.Queries (
import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings, appConnPool)) import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings, appConnPool))
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, getOsArch) 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)
import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||)) import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||))
@@ -123,53 +123,52 @@ getPackageIndexR = do
getOsVersionCompat <&> \case getOsVersionCompat <&> \case
Nothing -> const True Nothing -> const True
Just v -> flip satisfies v Just v -> flip satisfies v
osArch <- getOsArch
pkgArch <- getPkgArch >>= \case pkgArch <- getPkgArch >>= \case
Nothing -> pure $ [Nothing] Nothing -> pure []
Just a -> pure $ Just <$> a Just a -> pure a
ram <- getRamQuery ram <- getRamQuery
hardwareDevices <- getHardwareDevicesQuery hardwareDevices <- getHardwareDevicesQuery
communityVersion <- getsYesod $ communityVersion . appSettings communityVersion <- getsYesod $ communityVersion . appSettings
pool <- getsYesod appConnPool pool <- getsYesod appConnPool
do pkgIds <- getPkgIdsQuery
pkgIds <- getPkgIdsQuery category <- getCategoryQuery
category <- getCategoryQuery page <- fromMaybe 1 <$> getPageQuery
page <- fromMaybe 1 <$> getPageQuery 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 -> (serviceQuerySource category query osArch ram, const Any) Just packages ->
Just packages -> let s = getPkgDataSource (packageReqId <$> packages) pkgArch
let s = getPkgDataSource (packageReqId <$> packages) osArch r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages)
r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages) in (s, r)
in (s, r) filteredPackages <-
filteredPackages <- runDB $
runDB $ runConduit $
runConduit $ source
source -- group conduit pipeline by pkg id
-- group conduit pipeline by pkg id .| collateVersions
.| 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)))
.| mapC (second (filter (osPredicate . versionRecordOsVersion))) -- filter out deprecated service versions after community registry release
-- filter out deprecated service versions after community registry release .| mapC (second (filterDeprecatedVersions communityVersion osPredicate))
.| mapC (second (filterDeprecatedVersions communityVersion osPredicate)) -- filter hardware device compatability
.| mapMC (\(b,c) -> do .| mapMC (\(b,c) -> do
l <- filterDevices pool hardwareDevices pkgArch c l <- filterDevices pool hardwareDevices pkgArch c
pure (b, l) pure (b, l)
) )
-- prune empty version sets -- prune empty version sets
.| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
-- 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) <$> 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
-- 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 osPredicate) filteredPackages
PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies) PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies)
getPkgIdsQuery :: Handler (Maybe [PackageReq]) getPkgIdsQuery :: Handler (Maybe [PackageReq])
getPkgIdsQuery = parseQueryParam "ids" (first toS . eitherDecodeStrict . encodeUtf8) getPkgIdsQuery = parseQueryParam "ids" (first toS . eitherDecodeStrict . encodeUtf8)

29
src/Handler/Util.hs
View File

@@ -23,7 +23,7 @@ import Lib.PkgRepository (
PkgRepo, PkgRepo,
getHash, getHash,
) )
import Lib.Types.Core (PkgId, OsArch) import Lib.Types.Core (PkgId, OsArch (..))
import Lib.Types.Emver ( import Lib.Types.Emver (
Version, Version,
VersionRange, VersionRange,
@@ -61,7 +61,7 @@ import Startlude (
($), ($),
(.), (.),
(<$>), (<$>),
(>>=), note, (=<<), catMaybes, all, traverse, or (>>=), note, (=<<), catMaybes, all, traverse, or, encodeUtf8, toS
) )
import UnliftIO (MonadUnliftIO) import UnliftIO (MonadUnliftIO)
import Yesod ( import Yesod (
@@ -86,6 +86,8 @@ import Startlude (MonadIO)
import Text.Regex.TDFA ((=~)) import Text.Regex.TDFA ((=~))
import Startlude (filterM) import Startlude (filterM)
import Database.Persist.Postgresql (ConnectionPool, runSqlPool) import Database.Persist.Postgresql (ConnectionPool, runSqlPool)
import Data.Aeson (eitherDecodeStrict)
import Data.Bifunctor (Bifunctor(first))
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 =
@@ -201,13 +203,25 @@ getOsVersionQuery = parseQueryParam "os.version" ((flip $ note . mappend "Invali
getOsVersion :: Handler (Maybe Version) getOsVersion :: Handler (Maybe Version)
getOsVersion = do getOsVersion = do
osArch <- getOsVersionQuery >>= \case osVersion <- getOsVersionQuery >>= \case
Just a -> pure $ Just a Just a -> pure $ Just a
Nothing -> getOsVersionLegacy Nothing -> getOsVersionLegacy
pure osArch pure osVersion
getPkgArch :: Handler (Maybe [OsArch]) getPkgArch :: Handler (Maybe [OsArch])
getPkgArch = parseQueryParam "hardware.arch" ((flip $ note . mappend "Invalid 'arch': ") =<< readMaybe) getPkgArch = do
arch <- parseQueryParam "hardware.arch" parseArch >>= \case
Just a -> pure $ Just a
Nothing -> do
getOsArch >>= \case
Just a -> pure $ Just [a]
Nothing -> pure $ Just []
pure arch
-- >>> parseArch "[\"aarch64\"]"
-- Right [aarch64]
parseArch :: Text -> Either Text [OsArch]
parseArch = first toS . eitherDecodeStrict . encodeUtf8
filterDeprecatedVersions :: Version -> (Version -> Bool) -> [VersionRecord] -> [VersionRecord] filterDeprecatedVersions :: Version -> (Version -> Bool) -> [VersionRecord] -> [VersionRecord]
filterDeprecatedVersions communityVersion osPredicate vrs = do filterDeprecatedVersions communityVersion osPredicate vrs = do
@@ -215,7 +229,7 @@ filterDeprecatedVersions communityVersion osPredicate vrs = do
then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ vrs then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ vrs
else vrs else vrs
filterDevices :: (MonadUnliftIO m) => ConnectionPool -> (HM.HashMap Text Text) -> [Maybe OsArch] -> [VersionRecord] -> m [VersionRecord] filterDevices :: (MonadUnliftIO m) => ConnectionPool -> (HM.HashMap Text Text) -> [OsArch] -> [VersionRecord] -> m [VersionRecord]
filterDevices pool hardwareDevices arches pkgRecords = do filterDevices pool hardwareDevices arches pkgRecords = do
res <- filterM compareHd pkgRecords res <- filterM compareHd pkgRecords
pure res pure res
@@ -232,9 +246,10 @@ regexMatch (RegexPattern pattern) text = text =~ pattern
areRegexMatchesEqual :: (MonadIO m) => HM.HashMap Text Text -> PackageDevice -> m Bool areRegexMatchesEqual :: (MonadIO m) => HM.HashMap Text Text -> PackageDevice -> m Bool
areRegexMatchesEqual textMap (PackageDevice regexMap) = areRegexMatchesEqual textMap (PackageDevice regexMap) =
-- putStrLn @Text textMap
pure $ all checkMatch (HM.toList regexMap) pure $ all checkMatch (HM.toList regexMap)
where where
checkMatch :: (Text, RegexPattern) -> Bool checkMatch :: (Text, RegexPattern) -> Bool
checkMatch (key, regexPattern) = case HM.lookup key textMap of checkMatch (key, regexPattern) = case HM.lookup key textMap of
Just text -> regexMatch regexPattern text Just text -> regexMatch regexPattern text
Nothing -> False Nothing -> False

14
src/Lib/Types/Core.hs
View File

@@ -27,7 +27,7 @@ import Startlude (
show, show,
symbolVal, symbolVal,
($), ($),
(.), Enum, (.), Enum, Applicative (..),
) )
import Data.Aeson ( import Data.Aeson (
@@ -57,7 +57,8 @@ import Web.HttpApiData (
ToHttpApiData, ToHttpApiData,
) )
import Yesod (PathPiece (..)) import Yesod (PathPiece (..))
import Prelude (read) import Prelude (read, fail)
import Data.Aeson.Types (withText)
newtype PkgId = PkgId {unPkgId :: Text} newtype PkgId = PkgId {unPkgId :: Text}
deriving stock (Eq, Ord) deriving stock (Eq, Ord)
@@ -111,7 +112,14 @@ instance PersistField OsArch where
instance PersistFieldSql OsArch where instance PersistFieldSql OsArch where
sqlType _ = SqlString sqlType _ = SqlString
instance FromJSON OsArch where instance FromJSON OsArch where
parseJSON = parseJSON parseJSON = withText "OsArch" $ \case
"x86_64" -> pure X86_64
"aarch64" -> pure AARCH64
"raspberrypi" -> pure RASPBERRYPI
"rasberrypi" -> pure RASPBERRYPI
"x86_64-nonfree" -> pure X86_64_NONFREE
"arch64-nonfree"-> pure AARCH64_NONFREE
_ -> fail "Invalid OsArch value"
instance ToJSON OsArch where instance ToJSON OsArch where
toJSON = toJSON toJSON = toJSON

5
src/Lib/Types/Manifest.hs
View File

@@ -111,11 +111,10 @@ testManifest =
}, },
"hardware-requirements" { "hardware-requirements" {
"device": { "device": {
processor: "intel", "processor": "intel",
display: "r'^{.*}$'" "display": "r'^{.*}$'"
}, },
"ram": "8" "ram": "8"
} }
"assets": { "assets": {
"license": "LICENSE", "license": "LICENSE",