diff --git a/resources/apps/lnd/0.13.3.1/manifest.json b/resources/apps/lnd/0.13.3.1/manifest.json index 313f3b8..5d8a36b 100644 --- a/resources/apps/lnd/0.13.3.1/manifest.json +++ b/resources/apps/lnd/0.13.3.1/manifest.json @@ -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", diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index fe9d2d9..4576e39 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -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 \ No newline at end of file diff --git a/src/Handler/Package/V0/Latest.hs b/src/Handler/Package/V0/Latest.hs index d7a278c..c2fd4ed 100644 --- a/src/Handler/Package/V0/Latest.hs +++ b/src/Handler/Package/V0/Latest.hs @@ -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 $ diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs index 1edb2f2..80149c7 100644 --- a/src/Handler/Package/V1/Index.hs +++ b/src/Handler/Package/V1/Index.hs @@ -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,53 +123,52 @@ 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) - Just packages -> - let s = getPkgDataSource (packageReqId <$> packages) osArch - r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages) - in (s, r) - filteredPackages <- - runDB $ - runConduit $ - source - -- group conduit pipeline by pkg id - .| collateVersions - -- filter out versions of apps that are incompatible with the OS predicate - .| mapC (second (filter (osPredicate . versionRecordOsVersion))) - -- filter out deprecated service versions after community registry release - .| mapC (second (filterDeprecatedVersions communityVersion osPredicate)) - .| mapMC (\(b,c) -> do - l <- filterDevices pool hardwareDevices pkgArch c - pure (b, l) - ) - -- prune empty version sets - .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) - -- grab the latest matching version if it exists - .| concatMapC (\(a, b) -> (a,b,) <$> (selectLatestVersionFromSpec packageRanges b)) - -- construct - .| mapMC (\(a, b, c) -> PackageMetadata a b (versionRecordNumber c) <$> getCategoriesFor a) - -- pages start at 1 for some reason. TODO: make pages start at 0 - .| (dropC (limit' * (page - 1)) *> takeC limit') - .| sinkList + 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 pkgArch ram, const Any) + Just packages -> + let s = getPkgDataSource (packageReqId <$> packages) pkgArch + r = fromMaybe None . (flip lookup $ (packageReqId &&& packageReqVersion) <$> packages) + in (s, r) + filteredPackages <- + runDB $ + runConduit $ + source + -- group conduit pipeline by pkg id + .| collateVersions + -- filter out versions of apps that are incompatible with the OS predicate + .| 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) + ) + -- prune empty version sets + .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) + -- grab the latest matching version if it exists + .| concatMapC (\(a, b) -> (a,b,) <$> (selectLatestVersionFromSpec packageRanges b)) + -- construct + .| mapMC (\(a, b, c) -> PackageMetadata a b (versionRecordNumber c) <$> getCategoriesFor a) + -- pages start at 1 for some reason. TODO: make pages start at 0 + .| (dropC (limit' * (page - 1)) *> takeC limit') + .| sinkList - -- 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 - PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies) + -- 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 + PackageListRes <$> runConcurrently (zipWithM (Concurrently .* constructPackageListApiRes) filteredPackages pkgsWithDependencies) getPkgIdsQuery :: Handler (Maybe [PackageReq]) getPkgIdsQuery = parseQueryParam "ids" (first toS . eitherDecodeStrict . encodeUtf8) diff --git a/src/Handler/Util.hs b/src/Handler/Util.hs index d5a2094..752cc31 100644 --- a/src/Handler/Util.hs +++ b/src/Handler/Util.hs @@ -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,9 +246,10 @@ 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 checkMatch (key, regexPattern) = case HM.lookup key textMap of Just text -> regexMatch regexPattern text - Nothing -> False \ No newline at end of file + Nothing -> False diff --git a/src/Lib/Types/Core.hs b/src/Lib/Types/Core.hs index 0dbcffe..10474fa 100644 --- a/src/Lib/Types/Core.hs +++ b/src/Lib/Types/Core.hs @@ -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 diff --git a/src/Lib/Types/Manifest.hs b/src/Lib/Types/Manifest.hs index 8cd87ae..d9ed9c1 100644 --- a/src/Lib/Types/Manifest.hs +++ b/src/Lib/Types/Manifest.hs @@ -111,11 +111,10 @@ testManifest = }, "hardware-requirements" { "device": { - processor: "intel", - display: "r'^{.*}$'" + "processor": "intel", + "display": "r'^{.*}$'" }, "ram": "8" - } "assets": { "license": "LICENSE",