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

View File

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

View File

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

View File

@@ -16,9 +16,9 @@ import Lib.Types.Core (PkgId)
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 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 (getOsArch, filterDeprecatedVersions)
import Handler.Util (filterDeprecatedVersions, getPkgArch)
import Yesod.Core (getsYesod)
import Settings (AppSettings(communityVersion))
@@ -39,7 +39,9 @@ getVersionLatestR = do
getOsVersionCompat <&> \case
Nothing -> const True
Just v -> flip satisfies v
osArch <- getOsArch
pkgArch <- getPkgArch >>= \case
Nothing -> pure []
Just a -> pure a
communityServiceDeprecationVersion <- getsYesod $ communityVersion . appSettings
do
case lookup "ids" getParameters of
@@ -48,7 +50,7 @@ getVersionLatestR = do
Left _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages)
Right p -> do
let packageList = (,Nothing) <$> p
let source = getPkgDataSource p osArch
let source = getPkgDataSource p pkgArch
filteredPackages <-
runDB $
runConduit $

View File

@@ -28,7 +28,7 @@ import Database.Queries (
import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings, appConnPool))
import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..))
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.Types.Core (PkgId)
import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||))
@@ -123,24 +123,22 @@ getPackageIndexR = do
getOsVersionCompat <&> \case
Nothing -> const True
Just v -> flip satisfies v
osArch <- getOsArch
pkgArch <- getPkgArch >>= \case
Nothing -> pure $ [Nothing]
Just a -> pure $ Just <$> a
Nothing -> pure []
Just a -> pure a
ram <- getRamQuery
hardwareDevices <- getHardwareDevicesQuery
communityVersion <- getsYesod $ communityVersion . appSettings
pool <- getsYesod appConnPool
do
pkgIds <- getPkgIdsQuery
category <- getCategoryQuery
page <- fromMaybe 1 <$> getPageQuery
limit' <- fromMaybe 20 <$> getLimitQuery
query <- T.strip . fromMaybe "" <$> lookupGetParam "query"
let (source, packageRanges) = case pkgIds of
Nothing -> (serviceQuerySource category query osArch ram, const Any)
Nothing -> (serviceQuerySource category query pkgArch ram, const Any)
Just packages ->
let s = getPkgDataSource (packageReqId <$> packages) osArch
let s = getPkgDataSource (packageReqId <$> packages) pkgArch
r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages)
in (s, r)
filteredPackages <-
@@ -153,6 +151,7 @@ getPackageIndexR = do
.| mapC (second (filter (osPredicate . versionRecordOsVersion)))
-- filter out deprecated service versions after community registry release
.| mapC (second (filterDeprecatedVersions communityVersion osPredicate))
-- filter hardware device compatability
.| mapMC (\(b,c) -> do
l <- filterDevices pool hardwareDevices pkgArch c
pure (b, l)

View File

@@ -23,7 +23,7 @@ import Lib.PkgRepository (
PkgRepo,
getHash,
)
import Lib.Types.Core (PkgId, OsArch)
import Lib.Types.Core (PkgId, OsArch (..))
import Lib.Types.Emver (
Version,
VersionRange,
@@ -61,7 +61,7 @@ import Startlude (
($),
(.),
(<$>),
(>>=), note, (=<<), catMaybes, all, traverse, or
(>>=), note, (=<<), catMaybes, all, traverse, or, encodeUtf8, toS
)
import UnliftIO (MonadUnliftIO)
import Yesod (
@@ -86,6 +86,8 @@ import Startlude (MonadIO)
import Text.Regex.TDFA ((=~))
import Startlude (filterM)
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 action other =
@@ -201,13 +203,25 @@ getOsVersionQuery = parseQueryParam "os.version" ((flip $ note . mappend "Invali
getOsVersion :: Handler (Maybe Version)
getOsVersion = do
osArch <- getOsVersionQuery >>= \case
osVersion <- getOsVersionQuery >>= \case
Just a -> pure $ Just a
Nothing -> getOsVersionLegacy
pure osArch
pure osVersion
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 communityVersion osPredicate vrs = do
@@ -215,7 +229,7 @@ filterDeprecatedVersions communityVersion osPredicate vrs = do
then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ 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
res <- filterM compareHd pkgRecords
pure res
@@ -232,6 +246,7 @@ regexMatch (RegexPattern pattern) text = text =~ pattern
areRegexMatchesEqual :: (MonadIO m) => HM.HashMap Text Text -> PackageDevice -> m Bool
areRegexMatchesEqual textMap (PackageDevice regexMap) =
-- putStrLn @Text textMap
pure $ all checkMatch (HM.toList regexMap)
where
checkMatch :: (Text, RegexPattern) -> Bool

View File

@@ -27,7 +27,7 @@ import Startlude (
show,
symbolVal,
($),
(.), Enum,
(.), Enum, Applicative (..),
)
import Data.Aeson (
@@ -57,7 +57,8 @@ import Web.HttpApiData (
ToHttpApiData,
)
import Yesod (PathPiece (..))
import Prelude (read)
import Prelude (read, fail)
import Data.Aeson.Types (withText)
newtype PkgId = PkgId {unPkgId :: Text}
deriving stock (Eq, Ord)
@@ -111,7 +112,14 @@ instance PersistField OsArch where
instance PersistFieldSql OsArch where
sqlType _ = SqlString
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
toJSON = toJSON

View File

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