diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index 9aa0400..0a7d118 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -11,7 +11,7 @@ import Database.Persist.Sql ( SqlBackend, ) import Lib.Types.Core ( - PkgId, + PkgId, OsArch, ) import Lib.Types.Emver (Version) import Model ( @@ -19,7 +19,7 @@ import Model ( Metric (Metric), PkgDependency (..), PkgRecord (PkgRecord), - VersionRecord (VersionRecord), + VersionRecord (VersionRecord), VersionPlatform, EntityField (VersionPlatformPkgId, VersionPlatformVersionNumber, VersionPlatformArch, VersionPlatformId, VersionRecordId), ) import Orphans.Emver () import Startlude ( @@ -123,22 +123,29 @@ serviceQuerySource :: (MonadResource m, MonadIO m) => Maybe Text -> Text -> + OsArch -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) () -serviceQuerySource mCat query = selectSource $ do +serviceQuerySource mCat query osArch = selectSource $ do service <- case mCat of Nothing -> do - service <- from $ table @VersionRecord + (service :& vp) <- from $ table @VersionRecord + `innerJoin` table @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service)) + where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) + where_ (vp ^. VersionPlatformArch ==. val osArch) where_ $ queryInMetadata query service pure service Just category -> do - (service :& _ :& cat) <- + (service :& _ :& cat :& vp) <- 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)) -- 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) pure service groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) orderBy @@ -148,7 +155,6 @@ serviceQuerySource mCat query = selectSource $ do ] pure service - queryInMetadata :: Text -> SqlExpr (Entity VersionRecord) -> (SqlExpr (Value Bool)) queryInMetadata query service = (service ^. VersionRecordDescShort `ilike` (%) ++. val query ++. (%)) @@ -156,9 +162,12 @@ queryInMetadata query service = ||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%)) -getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) () -getPkgDataSource pkgs = selectSource $ do - pkgData <- from $ table @VersionRecord +getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> OsArch -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) () +getPkgDataSource pkgs osArch = 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 osArch) where_ (pkgData ^. VersionRecordPkgId `in_` valList (PkgRecordKey <$> pkgs)) pure pkgData diff --git a/src/Handler/Package/V0/Latest.hs b/src/Handler/Package/V0/Latest.hs index 9469ba9..cbbf836 100644 --- a/src/Handler/Package/V0/Latest.hs +++ b/src/Handler/Package/V0/Latest.hs @@ -18,6 +18,8 @@ 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 Control.Monad.Reader.Has ((>>=)) newtype VersionLatestRes = VersionLatestRes (HashMap PkgId (Maybe Version)) @@ -36,30 +38,33 @@ getVersionLatestR = do getOsVersionQuery <&> \case Nothing -> const True Just v -> flip satisfies v - case lookup "ids" getParameters of - Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "") - Just packages -> case eitherDecode $ LBS.fromStrict $ encodeUtf8 packages of - Left _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages) - Right p -> do - let packageList = (,Nothing) <$> p - let source = getPkgDataSource p - 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))) - -- prune empty version sets - .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) - -- grab the latest matching version if it exists - .| mapC (\(a, b) -> (a, (Just $ selectLatestVersion b))) - .| sinkList - -- if the requested package does not have available versions, return it as a key with a null value - pure $ - VersionLatestRes $ - HM.union (HM.fromList $ filteredPackages) (HM.fromList packageList) + getArchQuery >>= \case + Nothing -> sendResponseStatus status400 (InvalidParamsE "Param is required" "arch") + Just osArch -> do + case lookup "ids" getParameters of + Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "") + Just packages -> case eitherDecode $ LBS.fromStrict $ encodeUtf8 packages of + Left _ -> sendResponseStatus status400 (InvalidParamsE "get:ids" packages) + Right p -> do + let packageList = (,Nothing) <$> p + let source = getPkgDataSource p osArch + 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))) + -- prune empty version sets + .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) + -- grab the latest matching version if it exists + .| mapC (\(a, b) -> (a, (Just $ selectLatestVersion b))) + .| sinkList + -- if the requested package does not have available versions, return it as a key with a null value + pure $ + VersionLatestRes $ + HM.union (HM.fromList $ filteredPackages) (HM.fromList packageList) where selectLatestVersion :: NonEmpty VersionRecord -> Version selectLatestVersion vs = NE.head $ (versionRecordNumber <$>) $ NE.sortOn (Down . versionRecordNumber) $ vs diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs index c16dca9..e6d622a 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)) import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..)) import Handler.Types.Api (ApiVersion (..)) -import Handler.Util (basicRender, parseQueryParam) +import Handler.Util (basicRender, parseQueryParam, getArchQuery) import Lib.PkgRepository (PkgRepo, getIcon, getManifest) import Lib.Types.Core (PkgId) import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||)) @@ -87,7 +87,9 @@ import Yesod ( YesodPersist (runDB), lookupGetParam, ) - +import Yesod.Core.Handler (sendResponseStatus) +import Network.HTTP.Types (status400) +import Lib.Error (S9Error(InvalidParamsE)) data PackageReq = PackageReq { packageReqId :: !PkgId @@ -116,38 +118,41 @@ getPackageIndexR = do getOsVersionQuery <&> \case Nothing -> const True Just v -> flip satisfies v - 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, const Any) - Just packages -> - let s = getPkgDataSource (packageReqId <$> packages) - 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))) - -- 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 + getArchQuery >>= \case + Nothing -> sendResponseStatus status400 (InvalidParamsE "Param is required" "arch") + Just osArch -> 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, 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))) + -- 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/Model.hs b/src/Model.hs index 68f78ef..c0ff9c9 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -65,6 +65,16 @@ VersionRecord sql=version deriving Eq deriving Show +VersionPlatform + createdAt UTCTime + updatedAt UTCTime Maybe + pkgId PkgRecordId + versionNumber Version + arch OsArch + Primary pkgId versionNumber + deriving Eq + deriving Show + OsVersion createdAt UTCTime updatedAt UTCTime