rework filtering logic to eliminate hack db call

resources/apps/lnd/0.13.3.1/manifest.json

@@ -16,13 +16,13 @@
   "build": [
     "make"
   ],
-    "hardware-requirements" {
+    "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",

src/Database/Queries.hs

@@ -31,7 +31,7 @@ import Startlude (
     getCurrentTime,
     maybe,
     ($),
-    (.), Bool (False),
+    (.), Bool (False), fst,
  )
 import System.FilePath (takeExtension)
 import UnliftIO (
@@ -97,7 +97,7 @@ import Model (
         VersionRecordNumber,
         VersionRecordPkgId,
         VersionRecordTitle,
-        VersionRecordUpdatedAt, PkgRecordHidden, VersionPlatformRam
+        VersionRecordUpdatedAt, PkgRecordHidden, VersionPlatformRam, VersionPlatformCreatedAt, VersionPlatformUpdatedAt
     ),
     Key (unPkgRecordKey),
     PkgCategory,
@@ -116,7 +116,8 @@ import Startlude (
     ($>),
     (<$>), Int,
  )
-import Database.Esqueleto.Experimental ((>.))
+import Database.Esqueleto.Experimental (isNothing)
+import Database.Esqueleto.Experimental ((>=.))
 
 serviceQuerySource ::
     (MonadResource m, MonadIO m) =>
@@ -124,19 +125,19 @@ serviceQuerySource ::
     Text ->
     [OsArch] ->
     Maybe Int ->
-    ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
+    ConduitT () (Entity VersionRecord, Entity VersionPlatform) (ReaderT SqlBackend m) ()
 serviceQuerySource mCat query arches mRam = selectSource $ do
-    service <- case mCat of
+    (service, vp) <- 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 `in_` (valList $ Just <$> arches))
-            where_ (vp ^. VersionPlatformRam ==. val mRam)
+            where_ (vp ^. VersionPlatformRam >=. val mRam ||. isNothing (vp ^. VersionPlatformRam))
             where_ (pr ^. PkgRecordHidden ==. val False)
             where_ $ queryInMetadata query service
-            pure service
+            pure (service, vp)
         Just category -> do
             (service :& _ :& cat :& vp :& pr) <-
                 from $
@@ -150,16 +151,16 @@ serviceQuerySource mCat query arches mRam = selectSource $ do
             where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service
             where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
             where_ (vp ^. VersionPlatformArch `in_` (valList $ Just <$> arches))
-            where_ (vp ^. VersionPlatformRam >. val mRam)
+            where_ (vp ^. VersionPlatformRam >=. val mRam ||. isNothing (vp ^. VersionPlatformRam))
             where_ (pr ^. PkgRecordHidden ==. val False)
-            pure service
-    groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber)
+            pure (service, vp)
+    groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber, vp ^. VersionPlatformCreatedAt, vp ^. VersionPlatformUpdatedAt, vp ^. VersionPlatformPkgId, vp ^. VersionPlatformVersionNumber)
     orderBy
         [ asc (service ^. VersionRecordPkgId)
         , desc (service ^. VersionRecordNumber)
         , desc (service ^. VersionRecordUpdatedAt)
         ]
-    pure service
+    pure (service, vp)
 
 queryInMetadata :: Text -> SqlExpr (Entity VersionRecord) -> (SqlExpr (Value Bool))
 queryInMetadata query service =
@@ -168,15 +169,15 @@ queryInMetadata query service =
         ||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%))
 
 
-getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> [OsArch] -> Maybe Int -> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
+getPkgDataSource :: (MonadResource m, MonadIO m) => [PkgId] -> [OsArch] -> Maybe Int -> ConduitT () (Entity VersionRecord, Entity VersionPlatform) (ReaderT SqlBackend m) ()
 getPkgDataSource pkgs arches mRam = 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 `in_` (valList $ Just <$> arches))
-    where_ (vp ^. VersionPlatformRam ==. val mRam)
+    where_ (vp ^. VersionPlatformRam >=. val mRam ||. isNothing (vp ^. VersionPlatformRam))
     where_ (pkgData ^. VersionRecordPkgId `in_` valList (PkgRecordKey <$> pkgs))
-    pure pkgData
+    pure (pkgData, vp)
 
 
 getPkgDependencyData ::
@@ -219,18 +220,20 @@ getCategoriesFor pkg = fmap (fmap entityVal) $
 
 collateVersions ::
     MonadUnliftIO m =>
-    ConduitT (Entity VersionRecord) (PkgId, [VersionRecord]) (ReaderT SqlBackend m) ()
-collateVersions = awaitForever $ \v0 -> do
+    ConduitT (Entity VersionRecord, Entity VersionPlatform) (PkgId, [(VersionRecord, VersionPlatform)]) (ReaderT SqlBackend m) ()
+collateVersions = awaitForever $ \(v0, _) -> do
     let pkg = unPkgRecordKey . versionRecordPkgId $ entityVal v0
+    minput <- await
     let pull = do
-            mvn <- await
-            case mvn of
+            -- mvn <- await
+            case minput of
                 Nothing -> pure Nothing
                 Just vn -> do
-                    let pkg' = unPkgRecordKey . versionRecordPkgId $ entityVal vn
+                    let pkg' = unPkgRecordKey . versionRecordPkgId $ entityVal $ fst vn
                     if pkg == pkg' then pure (Just vn) else leftover vn $> Nothing
     ls <- unfoldM pull
-    yield (pkg, fmap entityVal $ v0 : ls)
+    let withoutEntity = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) ls
+    yield (pkg, withoutEntity)
 
 
 getDependencyVersions ::

src/Handler/Package/V0/Latest.hs

@@ -9,14 +9,14 @@ import Data.List (lookup)
 import Data.List.NonEmpty.Extra qualified as NE
 import Data.Tuple.Extra (second)
 import Database.Queries (collateVersions, getPkgDataSource)
-import Foundation (Handler, RegistryCtx (appSettings, appConnPool))
+import Foundation (Handler, RegistryCtx (appSettings))
 import Handler.Package.V1.Index (getOsVersionCompat, getRamQuery, getHardwareDevicesQuery)
 import Lib.Error (S9Error (..))
 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, ($), (.), (<$>), (<&>), (>>=), fst)
 import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)
 import Handler.Util (filterDeprecatedVersions, getPkgArch, filterDevices)
 import Yesod.Core (getsYesod)
@@ -45,7 +45,6 @@ getVersionLatestR = do
     ram <- getRamQuery
     hardwareDevices <- getHardwareDevicesQuery
     communityServiceDeprecationVersion <- getsYesod $ communityVersion . appSettings
-    pool <- getsYesod appConnPool
     do
         case lookup "ids" getParameters of
             Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "<MISSING>")
@@ -61,14 +60,14 @@ getVersionLatestR = do
                                     -- 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 communityServiceDeprecationVersion osPredicate'))
+                                    .| mapC (second (filter (osPredicate' . versionRecordOsVersion . fst)))
                                     -- filter hardware device compatability                        
                                     .| mapMC (\(b,c) -> do 
-                                        l <- filterDevices pool hardwareDevices pkgArch c
+                                        l <- filterDevices hardwareDevices pkgArch c
                                         pure (b, l)
                                         )
+                                    -- filter out deprecated service versions after community registry release
+                                    .| mapC (second (filterDeprecatedVersions communityServiceDeprecationVersion osPredicate'))
                                     -- prune empty version sets
                                     .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
                                     -- grab the latest matching version if it exists

src/Handler/Package/V1/Index.hs

@@ -25,7 +25,7 @@ import Database.Queries (
     getPkgDependencyData,
     serviceQuerySource,
  )
-import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings, appConnPool))
+import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings))
 import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..))
 import Handler.Types.Api (ApiVersion (..))
 import Handler.Util (basicRender, parseQueryParam, filterDeprecatedVersions, filterDevices, getPkgArch)
@@ -129,7 +129,6 @@ getPackageIndexR = do
     ram <- getRamQuery
     hardwareDevices <- getHardwareDevicesQuery
     communityVersion <- getsYesod $ communityVersion . appSettings
-    pool <- getsYesod appConnPool
     pkgIds <- getPkgIdsQuery
     category <- getCategoryQuery
     page <- fromMaybe 1 <$> getPageQuery
@@ -148,14 +147,14 @@ getPackageIndexR = do
                     -- 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))
+                    .| mapC (second (filter (osPredicate . versionRecordOsVersion . fst)))
                     -- filter hardware device compatability                        
                     .| mapMC (\(b,c) -> do 
-                        l <- filterDevices pool hardwareDevices pkgArch c
+                        l <- filterDevices hardwareDevices pkgArch c
                         pure (b, l)
                         )
+                    -- filter out deprecated service versions after community registry release
+                    .| mapC (second (filterDeprecatedVersions communityVersion osPredicate))
                     -- prune empty version sets
                     .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
                     -- grab the latest matching version if it exists

src/Handler/Util.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
 
 module Handler.Util where
 
@@ -61,7 +62,7 @@ import Startlude (
     ($),
     (.),
     (<$>),
-    (>>=), note, (=<<), catMaybes, all, traverse, or, encodeUtf8, toS
+    (>>=), note, (=<<), catMaybes, all, encodeUtf8, toS, fmap
  )
 import UnliftIO (MonadUnliftIO)
 import Yesod (
@@ -82,10 +83,7 @@ import Lib.Error (S9Error (..))
 import Data.Maybe (isJust)
 import qualified Data.HashMap.Strict as HM
 import Lib.Types.Manifest
-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))
 
@@ -229,25 +227,23 @@ filterDeprecatedVersions communityVersion osPredicate vrs = do
         then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ vrs
         else vrs
 
-filterDevices :: (MonadUnliftIO m) => ConnectionPool -> (HM.HashMap Text Text) -> [OsArch] -> [VersionRecord] -> m [VersionRecord]
-filterDevices pool hardwareDevices arches pkgRecords = do
-    res <- filterM compareHd pkgRecords
-    pure res
+filterDevices :: (MonadUnliftIO m) => (HM.HashMap Text Text) -> [OsArch] -> [(VersionRecord, VersionPlatform)] -> m [VersionRecord]
+filterDevices hardwareDevices arches pkgRecords = do
+    pure $ catMaybes $ fmap (compareHd hardwareDevices) pkgRecords
     where
-        compareHd pkgRecord = do
-            let id = versionRecordPkgId pkgRecord
-            platformDetails <- flip runSqlPool pool $ getVersionPlatform id arches
-            let pkgDevices = catMaybes $ versionPlatformDevice <$> platformDetails
-            t <- traverse (areRegexMatchesEqual hardwareDevices) pkgDevices
-            pure $ or t
+        compareHd :: HM.HashMap Text Text -> (VersionRecord, VersionPlatform) -> Maybe VersionRecord
+        compareHd hd (vr, vp) = case versionPlatformDevice vp of
+            Nothing -> Just vr
+            Just d -> if areRegexMatchesEqual hd d
+                then Just vr
+                else Nothing
 
 regexMatch :: RegexPattern -> Text -> Bool
 regexMatch (RegexPattern pattern) text = text =~ pattern
 
-areRegexMatchesEqual :: (MonadIO m) => HM.HashMap Text Text -> PackageDevice ->  m Bool
+areRegexMatchesEqual :: HM.HashMap Text Text -> PackageDevice ->  Bool
 areRegexMatchesEqual textMap (PackageDevice regexMap) =
-    -- putStrLn @Text textMap
-    pure $ all checkMatch (HM.toList regexMap)
+    all checkMatch (HM.toList regexMap)
   where
     checkMatch :: (Text, RegexPattern) -> Bool
     checkMatch (key, regexPattern) = case HM.lookup key textMap of