filter package index response by arch

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
 

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" "<MISSING>")
-        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" "<MISSING>")
+                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

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)

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