diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index ffe9390..9aa0400 100644 --- 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 diff --git a/src/Handler/Package/V0/Icon.hs b/src/Handler/Package/V0/Icon.hs index 9033e97..0f16584 100644 --- 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) diff --git a/src/Handler/Package/V0/Instructions.hs b/src/Handler/Package/V0/Instructions.hs index 7e3f629..0279c08 100644 --- 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) diff --git a/src/Handler/Package/V0/Latest.hs b/src/Handler/Package/V0/Latest.hs index 70e63d9..cffe72e 100644 --- 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" "") 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 diff --git a/src/Handler/Package/V0/License.hs b/src/Handler/Package/V0/License.hs index e152ee7..70645a5 100644 --- 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) diff --git a/src/Handler/Package/V0/Manifest.hs b/src/Handler/Package/V0/Manifest.hs index b42a194..f2dc965 100644 --- 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 diff --git a/src/Handler/Package/V0/ReleaseNotes.hs b/src/Handler/Package/V0/ReleaseNotes.hs index 5c04f15..e823e8b 100644 --- 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 diff --git a/src/Handler/Package/V0/S9PK.hs b/src/Handler/Package/V0/S9PK.hs index 92d3e69..0f00048 100644 --- 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 diff --git a/src/Handler/Package/V0/Version.hs b/src/Handler/Package/V0/Version.hs index 9996926..5145832 100644 --- 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}|]) diff --git a/src/Handler/Util.hs b/src/Handler/Util.hs index b34787d..cb207d0 100644 --- 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 diff --git a/src/Lib/PkgRepository.hs b/src/Lib/PkgRepository.hs index 3b0feaa..1e0d407 100644 --- 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