filter packages for os compatibility before fetching metadata

2026-03-26 10:21:51 +00:00 · 2022-07-09 08:35:58 -06:00
parent 18b951388b
commit 2cde1a2d8e
9 changed files with 279 additions and 71 deletions
--- a/src/Handler/Package/V0/Icon.hs
+++ b/src/Handler/Package/V0/Icon.hs
@@ -2,30 +2,49 @@

 module Handler.Package.V0.Icon where

-import Conduit (awaitForever, (.|))
+import Conduit (
+    awaitForever,
+    (.|),
+ )
 import Data.String.Interpolate.IsString (
    i,
 )
 import Foundation (Handler)
+import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
+    filterOsCompat,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
 )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getIcon)
+import Lib.PkgRepository (
+    getBestVersion,
+    getIcon,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
-import Startlude (show, ($))
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus)
+import Startlude (
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+ )


 getIconsR :: PkgId -> Handler TypedContent
 getIconsR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- filterOsCompat osVersion pkg
    spec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion pkg spec preferMin
+        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
@@ -2,24 +2,50 @@

 module Handler.Package.V0.Instructions where

-import Conduit (awaitForever, (.|))
-import Data.String.Interpolate.IsString (i)
+import Conduit (
+    awaitForever,
+    (.|),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
-import Handler.Util (getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    filterOsCompat,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getInstructions)
+import Lib.PkgRepository (
+    getBestVersion,
+    getInstructions,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
-import Startlude (show, ($))
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus, typePlain)
+import Startlude (
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+    typePlain,
+ )


 getInstructionsR :: PkgId -> Handler TypedContent
 getInstructionsR pkg = do
    spec <- getVersionSpecFromQuery
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- filterOsCompat osVersion pkg
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion pkg spec preferMin
+        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/License.hs
+++ b/src/Handler/Package/V0/License.hs
@@ -2,24 +2,50 @@

 module Handler.Package.V0.License where

-import Conduit (awaitForever, (.|))
-import Data.String.Interpolate.IsString (i)
+import Conduit (
+    awaitForever,
+    (.|),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
-import Handler.Util (getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    filterOsCompat,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getLicense)
+import Lib.PkgRepository (
+    getBestVersion,
+    getLicense,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status400)
-import Startlude (show, ($))
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus, typePlain)
+import Startlude (
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+    typePlain,
+ )


 getLicenseR :: PkgId -> Handler TypedContent
 getLicenseR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- filterOsCompat osVersion pkg
    spec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion pkg spec preferMin
+        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
@@ -2,26 +2,53 @@

 module Handler.Package.V0.Manifest where

-import Conduit (awaitForever, (.|))
-import Data.String.Interpolate.IsString (i)
+import Conduit (
+    awaitForever,
+    (.|),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
-import Handler.Util (addPackageHeader, getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    addPackageHeader,
+    filterOsCompat,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getManifest)
+import Lib.PkgRepository (
+    getBestVersion,
+    getManifest,
+ )
 import Lib.Types.Core (PkgId)
 import Network.HTTP.Types (status404)
-import Startlude (show, ($))
-import Yesod (TypedContent, addHeader, respondSource, sendChunkBS, sendResponseStatus, typeJson)
+import Startlude (
+    show,
+    ($),
+ )
+import Yesod (
+    TypedContent,
+    addHeader,
+    respondSource,
+    sendChunkBS,
+    sendResponseStatus,
+    typeJson,
+ )


 getAppManifestR :: PkgId -> Handler TypedContent
 getAppManifestR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- filterOsCompat osVersion pkg
    versionSpec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion pkg versionSpec preferMin
+        getBestVersion versionSpec preferMin osCompatibleVersions
            `orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
    addPackageHeader pkg version
    (len, src) <- getManifest pkg version
    addHeader "Content-Length" (show len)
-    respondSource typeJson $ src .| awaitForever sendChunkBS
+    respondSource typeJson $ src .| awaitForever sendChunkBS
--- a/src/Handler/Package/V0/ReleaseNotes.hs
+++ b/src/Handler/Package/V0/ReleaseNotes.hs
@@ -2,23 +2,45 @@

 module Handler.Package.V0.ReleaseNotes where

-import Data.Aeson (ToJSON (..), object, KeyValue((.=)))
+import Data.Aeson (
+    KeyValue ((.=)),
+    ToJSON (..),
+    object,
+ )
+import Data.Aeson.Key (fromText)
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HM
-import Database.Queries (fetchAllAppVersions)
-import Foundation (Handler, RegistryCtx (..))
+import Foundation (Handler)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (filterOsCompat)
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (Version)
 import Model (VersionRecord (..))
-import Startlude (Down (..), Eq, Show, Text, fst, pure, sortOn, ($), (&&&), (.), (<$>), show)
-import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), getYesod)
-import Data.Aeson.Key (fromText)
+import Startlude (
+    Down (..),
+    Eq,
+    Show,
+    Text,
+    fst,
+    pure,
+    show,
+    sortOn,
+    ($),
+    (&&&),
+    (.),
+    (<$>),
+ )
+import Yesod (
+    ToContent (..),
+    ToTypedContent (..),
+ )


 newtype ReleaseNotes = ReleaseNotes {unReleaseNotes :: HashMap Version Text}
    deriving (Eq, Show)
 instance ToJSON ReleaseNotes where
-    toJSON ReleaseNotes {..} = object [ version .= value | (key, value) <- HM.toList unReleaseNotes, let version = fromText $ show key]
+    toJSON ReleaseNotes{..} =
+        object [version .= value | (key, value) <- HM.toList unReleaseNotes, let version = fromText $ show key]
 instance ToContent ReleaseNotes where
    toContent = toContent . toJSON
 instance ToTypedContent ReleaseNotes where
@@ -27,9 +49,9 @@ instance ToTypedContent ReleaseNotes where

 getReleaseNotesR :: PkgId -> Handler ReleaseNotes
 getReleaseNotesR pkg = do
-    appConnPool <- appConnPool <$> getYesod
-    versionRecords <- runDB $ fetchAllAppVersions appConnPool pkg
-    pure $ constructReleaseNotesApiRes versionRecords
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- filterOsCompat osVersion pkg
+    pure $ constructReleaseNotesApiRes osCompatibleVersions
    where
        constructReleaseNotesApiRes :: [VersionRecord] -> ReleaseNotes
        constructReleaseNotesApiRes vers = do
--- a/src/Handler/Package/V0/S9PK.hs
+++ b/src/Handler/Package/V0/S9PK.hs
@@ -4,30 +4,65 @@

 module Handler.Package.V0.S9PK where

-import Data.String.Interpolate.IsString (i)
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Data.Text qualified as T
-import Database.Queries (createMetric, fetchAppVersion)
+import Database.Queries (
+    createMetric,
+    fetchAppVersion,
+ )
 import Foundation (Handler)
 import GHC.Show (show)
-import Handler.Util (addPackageHeader, getVersionSpecFromQuery, orThrow, versionPriorityFromQueryIsMin)
+import Handler.Package.V1.Index (getOsVersionQuery)
+import Handler.Util (
+    addPackageHeader,
+    filterOsCompat,
+    getVersionSpecFromQuery,
+    orThrow,
+    versionPriorityFromQueryIsMin,
+ )
 import Lib.Error (S9Error (..))
-import Lib.PkgRepository (getBestVersion, getPackage)
-import Lib.Types.Core (PkgId (..), S9PK)
+import Lib.PkgRepository (
+    getBestVersion,
+    getPackage,
+ )
+import Lib.Types.Core (
+    PkgId (..),
+    S9PK,
+ )
 import Lib.Types.Emver (Version (..))
 import Network.HTTP.Types (status404)
-import Startlude (Maybe (..), pure, void, ($), (.), (>>=))
+import Startlude (
+    Maybe (..),
+    pure,
+    void,
+    ($),
+    (.),
+    (>>=),
+ )
 import System.FilePath (takeBaseName)
-import Yesod (Content (..), TypedContent, YesodPersist (runDB), notFound, respond, sendResponseStatus, typeOctet)
+import Yesod (
+    Content (..),
+    TypedContent,
+    YesodPersist (runDB),
+    notFound,
+    respond,
+    sendResponseStatus,
+    typeOctet,
+ )
 import Yesod.Core (logError)


 getAppR :: S9PK -> Handler TypedContent
 getAppR file = do
    let pkg = PkgId . T.pack $ takeBaseName (show file)
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- filterOsCompat osVersion pkg
    versionSpec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
    version <-
-        getBestVersion pkg versionSpec preferMin
+        getBestVersion versionSpec preferMin osCompatibleVersions
            `orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
    addPackageHeader pkg version
    void $ recordMetrics pkg version
@@ -42,8 +77,7 @@ recordMetrics :: PkgId -> Version -> Handler ()
 recordMetrics pkg appVersion = do
    existingVersion <- runDB $ fetchAppVersion pkg appVersion
    case existingVersion of
-        Nothing ->
-            do
-                $logError [i|#{pkg}@#{appVersion} not found in database|]
-                notFound
-        Just _ -> runDB $ createMetric pkg appVersion
+        Nothing -> do
+            $logError [i|#{pkg}@#{appVersion} not found in database|]
+            notFound
+        Just _ -> runDB $ createMetric pkg appVersion
--- a/src/Handler/Package/V0/Version.hs
+++ b/src/Handler/Package/V0/Version.hs
@@ -2,10 +2,18 @@

 module Handler.Package.V0.Version where

-import Data.Aeson (ToJSON, object, (.=))
-import Data.String.Interpolate.IsString (i)
+import Data.Aeson (
+    ToJSON,
+    object,
+    (.=),
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 import Foundation (Handler)
+import Handler.Package.V1.Index (getOsVersionQuery)
 import Handler.Util (
+    filterOsCompat,
    getVersionSpecFromQuery,
    orThrow,
    versionPriorityFromQueryIsMin,
@@ -15,9 +23,22 @@ import Lib.PkgRepository (getBestVersion)
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (Version (..))
 import Network.HTTP.Types (status404)
-import Startlude (Eq, Maybe, Show, (.), (<$>))
-import Yesod (ToContent (..), ToTypedContent, sendResponseStatus)
-import Yesod.Core (ToJSON (..), ToTypedContent (..))
+import Startlude (
+    Eq,
+    Maybe,
+    Show,
+    (.),
+    (<$>),
+ )
+import Yesod (
+    ToContent (..),
+    ToTypedContent,
+    sendResponseStatus,
+ )
+import Yesod.Core (
+    ToJSON (..),
+    ToTypedContent (..),
+ )


 newtype AppVersionRes = AppVersionRes
@@ -38,9 +59,11 @@ instance ToTypedContent (Maybe AppVersionRes) where

 getPkgVersionR :: PkgId -> Handler AppVersionRes
 getPkgVersionR pkg = do
+    osVersion <- getOsVersionQuery
+    osCompatibleVersions <- filterOsCompat osVersion pkg
    spec <- getVersionSpecFromQuery
    preferMin <- versionPriorityFromQueryIsMin
-    AppVersionRes <$> getBestVersion pkg spec preferMin
+    AppVersionRes <$> getBestVersion spec preferMin osCompatibleVersions
        `orThrow` sendResponseStatus
            status404
-            (NotFoundE [i|Version for #{pkg} satisfying #{spec}|])
+            (NotFoundE [i|Version for #{pkg} satisfying #{spec}|])
--- a/src/Handler/Util.hs
+++ b/src/Handler/Util.hs
@@ -6,19 +6,32 @@ import Control.Monad.Reader.Has (
    Has,
    MonadReader,
 )
-import Data.Attoparsec.Text (Parser, parseOnly)
-import Data.String.Interpolate.IsString (i)
+import Data.Attoparsec.Text (
+    Parser,
+    parseOnly,
+ )
+import Data.String.Interpolate.IsString (
+    i,
+ )
 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 Foundation
-import Lib.PkgRepository (PkgRepo, getHash)
+import Lib.PkgRepository (
+    PkgRepo,
+    getHash,
+ )
 import Lib.Types.Core (PkgId)
 import Lib.Types.Emver (
    Version,
    VersionRange,
+    satisfies,
+ )
+import Model (
+    UserActivity (..),
+    VersionRecord (versionRecordOsVersion),
 )
-import Model (UserActivity (..))
 import Network.HTTP.Types (
    Status,
    status400,
@@ -31,7 +44,10 @@ import Startlude (
    Monoid (..),
    Semigroup ((<>)),
    Text,
+    const,
    decodeUtf8,
+    filter,
+    flip,
    fromMaybe,
    fst,
    getCurrentTime,
@@ -48,10 +64,12 @@ import Startlude (
 )
 import UnliftIO (MonadUnliftIO)
 import Yesod (
+    HandlerFor,
    MonadHandler,
    RenderRoute (..),
    TypedContent (..),
    YesodPersist (runDB),
+    getYesod,
    insertRecord,
    liftHandler,
    lookupGetParam,
@@ -106,8 +124,7 @@ queryParamAs k p =
    lookupGetParam k >>= \case
        Nothing -> pure Nothing
        Just x -> case parseOnly p x of
-            Left e ->
-                sendResponseText status400 [i|Invalid Request! The query parameter '#{k}' failed to parse: #{e}|]
+            Left e -> sendResponseText status400 [i|Invalid Request! The query parameter '#{k}' failed to parse: #{e}|]
            Right a -> pure (Just a)


@@ -118,3 +135,15 @@ tickleMAU = do
        Just sid -> do
            now <- liftIO getCurrentTime
            void $ liftHandler $ runDB $ insertRecord $ UserActivity now sid
+
+
+filterOsCompat :: Maybe VersionRange -> PkgId -> HandlerFor RegistryCtx [VersionRecord]
+filterOsCompat osVersion pkg = do
+    appConnPool <- appConnPool <$> getYesod
+    versionRecords <- runDB $ fetchAllAppVersions appConnPool pkg
+    pure $ filter (osPredicate osVersion . versionRecordOsVersion) versionRecords
+    where
+        osPredicate osV = do
+            case osV of
+                Nothing -> const True
+                Just v -> flip satisfies v
--- a/src/Lib/PkgRepository.hs
+++ b/src/Lib/PkgRepository.hs
@@ -68,22 +68,24 @@ import Database.Persist.Sql (
 import Database.PostgreSQL.Simple (SqlError (sqlState))
 import Lib.Error (S9Error (NotFoundE))
 import Lib.External.AppMgr qualified as AppMgr
-import Lib.Types.Core (
-    PkgId (..),
- )
+import Lib.Types.Core (PkgId (..))
 import Lib.Types.Emver (
    Version,
    VersionRange,
    parseVersion,
    satisfies,
 )
-import Lib.Types.Manifest (PackageDependency (..), PackageManifest (..))
+import Lib.Types.Manifest (
+    PackageDependency (..),
+    PackageManifest (..),
+ )
 import Model (
    EntityField (EosHashHash, PkgRecordUpdatedAt),
    EosHash (EosHash),
    Key (PkgRecordKey),
    PkgDependency (PkgDependency),
    PkgRecord (PkgRecord),
+    VersionRecord (versionRecordNumber),
 )
 import Startlude (
    Bool (..),
@@ -208,17 +210,17 @@ getVersionsFor pkg = do
        else pure []


-getViableVersions :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m) => PkgId -> VersionRange -> m [Version]
-getViableVersions pkg spec = filter (`satisfies` spec) <$> getVersionsFor pkg
+getViableVersions :: VersionRange -> [VersionRecord] -> [Version]
+getViableVersions spec vrs = filter (`satisfies` spec) (versionRecordNumber <$> vrs)


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