address PR feedback and add os filtering to get package latest version endpoint

2026-03-26 10:21:51 +00:00 · 2022-07-09 16:01:46 -06:00
parent 2cde1a2d8e
commit 4e2285f130
11 changed files with 67 additions and 46 deletions
--- a/src/Database/Queries.hs
+++ b/src/Database/Queries.hs
@@ -229,8 +229,8 @@ getDependencyVersions pkgDepRecord = do
    pure $ entityVal <$> depVers


-fetchAllAppVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord]
-fetchAllAppVersions appConnPool appId = do
+fetchAllPkgVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m [VersionRecord]
+fetchAllPkgVersions appConnPool appId = do
    entityAppVersions <- runSqlPool (P.selectList [VersionRecordPkgId P.==. PkgRecordKey appId] []) appConnPool
    pure $ entityVal <$> entityAppVersions

--- a/src/Handler/Package/V0/Icon.hs
+++ b/src/Handler/Package/V0/Icon.hs
@@ -12,7 +12,7 @@ import Data.String.Interpolate.IsString (
 import Foundation (Handler)
 import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
-    filterOsCompat,
+    fetchCompatiblePkgVersions,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
@@ -25,6 +25,7 @@ import Lib.PkgRepository (
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
 import Startlude (
+    pure,
    show,
    ($),
 )
@@ -40,11 +41,11 @@ import Yesod (
 getIconsR :: PkgId -> Handler TypedContent
 getIconsR pkg = do
    osVersion <- getOsVersionQuery
-    osCompatibleVersions <- filterOsCompat osVersion pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
    spec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion spec preferMin osCompatibleVersions
+        (pure $ getBestVersion spec preferMin osCompatibleVersions)
            `orThrow` sendResponseStatus status400 (NotFoundE [i|Icon for #{pkg} satisfying #{spec}|])
    (ct, len, src) <- getIcon pkg version
    addHeader "Content-Length" (show len)
--- a/src/Handler/Package/V0/Instructions.hs
+++ b/src/Handler/Package/V0/Instructions.hs
@@ -12,7 +12,7 @@ import Data.String.Interpolate.IsString (
 import Foundation (Handler)
 import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
-    filterOsCompat,
+    fetchCompatiblePkgVersions,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
@@ -25,6 +25,7 @@ import Lib.PkgRepository (
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
 import Startlude (
+    pure,
    show,
    ($),
 )
@@ -42,10 +43,12 @@ getInstructionsR :: PkgId -> Handler TypedContent
 getInstructionsR pkg = do
    spec <- getVersionSpecFromQuery
    osVersion <- getOsVersionQuery
-    osCompatibleVersions <- filterOsCompat osVersion pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion spec preferMin osCompatibleVersions
+        ( pure $
+                getBestVersion spec preferMin osCompatibleVersions
+            )
            `orThrow` sendResponseStatus status400 (NotFoundE [i|Instructions for #{pkg} satisfying #{spec}|])
    (len, src) <- getInstructions pkg version
    addHeader "Content-Length" (show len)
--- a/src/Handler/Package/V0/Latest.hs
+++ b/src/Handler/Package/V0/Latest.hs
@@ -1,19 +1,22 @@
 module Handler.Package.V0.Latest where

+import Conduit (mapC, runConduit, sinkList, (.|))
 import Data.Aeson (ToJSON (..), eitherDecode)
 import Data.ByteString.Lazy qualified as LBS
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
-import Data.List (lookup)
-import Database.Queries (fetchLatestApp)
+import Data.List (lookup, sortOn)
+import Data.Tuple.Extra (second)
+import Database.Queries (collateVersions, getPkgDataSource)
 import Foundation (Handler)
+import Handler.Package.V1.Index (getOsVersionQuery)
 import Lib.Error (S9Error (..))
 import Lib.Types.Core (PkgId)
-import Lib.Types.Emver (Version)
-import Model (Key (..), VersionRecord (..))
+import Lib.Types.Emver (Version, satisfies)
+import Model (VersionRecord (..))
 import Network.HTTP.Types (status400)
-import Startlude (Either (..), Generic, Maybe (..), Show, catMaybes, encodeUtf8, fst, pure, snd, traverse, ($), (.), (<$>))
-import Yesod (Entity (..), ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)
+import Startlude (Bool (True), Down (Down), Either (..), Generic, Maybe (..), Show, const, encodeUtf8, filter, flip, headMay, pure, ($), (.), (<$>), (<&>))
+import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus)


 newtype VersionLatestRes = VersionLatestRes (HashMap PkgId (Maybe Version))
@@ -25,24 +28,36 @@ instance ToTypedContent VersionLatestRes where
    toTypedContent = toTypedContent . toJSON


-- TODO refactor with conduit
 getVersionLatestR :: Handler VersionLatestRes
 getVersionLatestR = do
    getParameters <- reqGetParams <$> getRequest
+    osPredicate' <-
+        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
-                found <- runDB $ traverse fetchLatestApp $ fst <$> packageList
+                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
+                                -- grab the latest matching version if it exists
+                                .| mapC (\(a, b) -> (a, (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 $
-                                ( \v ->
-                                    (unPkgRecordKey . entityKey $ fst v, Just $ versionRecordNumber $ entityVal $ snd v)
-                                )
-                                    <$> catMaybes found
-                            )
-                            $ HM.fromList packageList
+                        HM.union (HM.fromList $ filteredPackages) (HM.fromList packageList)
+    where
+        selectLatestVersion :: [VersionRecord] -> Maybe Version
+        selectLatestVersion vs = headMay $ (versionRecordNumber <$>) $ sortOn (Down . versionRecordNumber) $ vs
--- a/src/Handler/Package/V0/License.hs
+++ b/src/Handler/Package/V0/License.hs
@@ -12,7 +12,7 @@ import Data.String.Interpolate.IsString (
 import Foundation (Handler)
 import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
-    filterOsCompat,
+    fetchCompatiblePkgVersions,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
@@ -25,6 +25,7 @@ import Lib.PkgRepository (
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
 import Startlude (
+    pure,
    show,
    ($),
 )
@@ -41,11 +42,11 @@ import Yesod (
 getLicenseR :: PkgId -> Handler TypedContent
 getLicenseR pkg = do
    osVersion <- getOsVersionQuery
-    osCompatibleVersions <- filterOsCompat osVersion pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
    spec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion spec preferMin osCompatibleVersions
+        (pure $ getBestVersion spec preferMin osCompatibleVersions)
            `orThrow` sendResponseStatus status400 (NotFoundE [i|License for #{pkg} satisfying #{spec}|])
    (len, src) <- getLicense pkg version
    addHeader "Content-Length" (show len)
--- a/src/Handler/Package/V0/Manifest.hs
+++ b/src/Handler/Package/V0/Manifest.hs
@@ -13,7 +13,7 @@ import Foundation (Handler)
 import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
    addPackageHeader,
-    filterOsCompat,
+    fetchCompatiblePkgVersions,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
@@ -26,6 +26,7 @@ import Lib.PkgRepository (
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status404)
 import Startlude (
+    pure,
    show,
    ($),
 )
@@ -42,11 +43,11 @@ import Yesod (
 getAppManifestR :: PkgId -> Handler TypedContent
 getAppManifestR pkg = do
    osVersion <- getOsVersionQuery
-    osCompatibleVersions <- filterOsCompat osVersion pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
    versionSpec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion versionSpec preferMin osCompatibleVersions
+        (pure $ getBestVersion versionSpec preferMin osCompatibleVersions)
            `orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
    addPackageHeader pkg version
    (len, src) <- getManifest pkg version
--- a/src/Handler/Package/V0/ReleaseNotes.hs
+++ b/src/Handler/Package/V0/ReleaseNotes.hs
@@ -12,7 +12,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
 import Foundation (Handler)
 import Handler.Package.V1.Index (getOsVersionQuery)
-import Handler.Util (filterOsCompat)
+import Handler.Util (fetchCompatiblePkgVersions)
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (Version)
 import Model (VersionRecord (..))
@@ -50,7 +50,7 @@ instance ToTypedContent ReleaseNotes where
 getReleaseNotesR :: PkgId -> Handler ReleaseNotes
 getReleaseNotesR pkg = do
    osVersion <- getOsVersionQuery
-    osCompatibleVersions <- filterOsCompat osVersion pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
    pure $ constructReleaseNotesApiRes osCompatibleVersions
    where
        constructReleaseNotesApiRes :: [VersionRecord] -> ReleaseNotes
--- a/src/Handler/Package/V0/S9PK.hs
+++ b/src/Handler/Package/V0/S9PK.hs
@@ -17,7 +17,7 @@ import GHC.Show (show)
 import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
    addPackageHeader,
-    filterOsCompat,
+    fetchCompatiblePkgVersions,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
@@ -58,11 +58,11 @@ getAppR :: S9PK -> Handler TypedContent
 getAppR file = do
    let pkg = PkgId . T.pack $ takeBaseName (show file)
    osVersion <- getOsVersionQuery
-    osCompatibleVersions <- filterOsCompat osVersion pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
    versionSpec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion versionSpec preferMin osCompatibleVersions
+        (pure $ getBestVersion versionSpec preferMin osCompatibleVersions)
            `orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
    addPackageHeader pkg version
    void $ recordMetrics pkg version
--- a/src/Handler/Package/V0/Version.hs
+++ b/src/Handler/Package/V0/Version.hs
@@ -13,7 +13,7 @@ import Data.String.Interpolate.IsString (
 import Foundation (Handler)
 import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
-    filterOsCompat,
+    fetchCompatiblePkgVersions,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
@@ -27,6 +27,8 @@ import Startlude (
    Eq,
    Maybe,
    Show,
+    pure,
+    ($),
    (.),
    (<$>),
 )
@@ -60,10 +62,10 @@ instance ToTypedContent (Maybe AppVersionRes) where
 getPkgVersionR :: PkgId -> Handler AppVersionRes
 getPkgVersionR pkg = do
    osVersion <- getOsVersionQuery
-    osCompatibleVersions <- filterOsCompat osVersion pkg
+    osCompatibleVersions <- fetchCompatiblePkgVersions osVersion pkg
    spec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
-    AppVersionRes <$> getBestVersion spec preferMin osCompatibleVersions
+    AppVersionRes <$> (pure $ getBestVersion spec preferMin osCompatibleVersions)
        `orThrow` sendResponseStatus
            status404
            (NotFoundE [i|Version for #{pkg} satisfying #{spec}|])
--- a/src/Handler/Util.hs
+++ b/src/Handler/Util.hs
@@ -16,7 +16,7 @@ import Data.String.Interpolate.IsString (
 import Data.Text qualified as T
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Builder qualified as TB
-import Database.Queries (fetchAllAppVersions)
+import Database.Queries (fetchAllPkgVersions)
 import Foundation
 import Lib.PkgRepository (
    PkgRepo,
@@ -64,7 +64,6 @@ import Startlude (
 )
 import UnliftIO (MonadUnliftIO)
 import Yesod (
-    HandlerFor,
    MonadHandler,
    RenderRoute (..),
    TypedContent (..),
@@ -137,10 +136,10 @@ tickleMAU = do
            void $ liftHandler $ runDB $ insertRecord $ UserActivity now sid


-filterOsCompat :: Maybe VersionRange -> PkgId -> HandlerFor RegistryCtx [VersionRecord]
-filterOsCompat osVersion pkg = do
+fetchCompatiblePkgVersions :: Maybe VersionRange -> PkgId -> Handler [VersionRecord]
+fetchCompatiblePkgVersions osVersion pkg = do
    appConnPool <- appConnPool <$> getYesod
-    versionRecords <- runDB $ fetchAllAppVersions appConnPool pkg
+    versionRecords <- runDB $ fetchAllPkgVersions appConnPool pkg
    pure $ filter (osPredicate osVersion . versionRecordOsVersion) versionRecords
    where
        osPredicate osV = do
--- a/src/Lib/PkgRepository.hs
+++ b/src/Lib/PkgRepository.hs
@@ -215,12 +215,11 @@ getViableVersions spec vrs = filter (`satisfies` spec) (versionRecordNumber <$>


 getBestVersion ::
-    (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) =>
    VersionRange ->
    Bool ->
    [VersionRecord] ->
-    m (Maybe Version)
-getBestVersion spec preferMin vrs = headMay . sortBy comparator <$> (pure $ getViableVersions spec vrs)
+    (Maybe Version)
+getBestVersion spec preferMin vrs = headMay $ sortBy comparator $ getViableVersions spec vrs
    where
        comparator = if preferMin then compare else compare `on` Down