diff --git a/config/settings.yml b/config/settings.yml index f3d4114..b90f685 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -36,7 +36,8 @@ tor-port: "_env:TOR_PORT:447" static-bin-dir: "_env:STATIC_BIN:/usr/local/bin/" error-log-root: "_env:ERROR_LOG_ROOT:/var/log/registry/" marketplace-name: "_env:MARKETPLACE_NAME:CHANGE ME" -max-eos-version: "_env:MAX_VERSION:0.3.3.0" +max-eos-version: "_env:MAX_VERSION:0.3.4.0" +min-eos-version: "_env:MIN_VERSION:0.3.4.0" run-migration: "_env:RUN_MIGRATION:false" database: diff --git a/src/Database/Queries.hs b/src/Database/Queries.hs index cb5a43f..e5f52ad 100644 --- a/src/Database/Queries.hs +++ b/src/Database/Queries.hs @@ -31,7 +31,7 @@ import Startlude ( getCurrentTime, maybe, ($), - (.), + (.), Bool (False), ) import System.FilePath (takeExtension) import UnliftIO ( @@ -97,7 +97,7 @@ import Model ( VersionRecordNumber, VersionRecordPkgId, VersionRecordTitle, - VersionRecordUpdatedAt + VersionRecordUpdatedAt, PkgRecordHidden ), Key (unPkgRecordKey), PkgCategory, @@ -105,7 +105,6 @@ import Model ( ) import Startlude ( Applicative (pure), - Bool, Down (Down), Eq ((==)), Functor (fmap), @@ -118,7 +117,6 @@ import Startlude ( (<$>), ) - serviceQuerySource :: (MonadResource m, MonadIO m) => Maybe Text -> @@ -130,24 +128,28 @@ serviceQuerySource mCat query mOsArch = selectSource $ do Just osArch -> do service <- case mCat of Nothing -> do - (service :& vp) <- from $ table @VersionRecord + (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 ==. val osArch) + where_ (pr ^. PkgRecordHidden ==. val False) where_ $ queryInMetadata query service pure service Just category -> do - (service :& _ :& cat :& vp) <- + (service :& _ :& cat :& vp :& pr) <- 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)) + `innerJoin` table @PkgRecord `on` (\(v :& _ :& _ :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) -- 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) + where_ (pr ^. PkgRecordHidden ==. val False) pure service groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) orderBy @@ -159,18 +161,22 @@ serviceQuerySource mCat query mOsArch = selectSource $ do Nothing -> do service <- case mCat of Nothing -> do - service <- from $ table @VersionRecord + (service :& pr) <- from $ table @VersionRecord + `innerJoin` table @PkgRecord `on` (\(v :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) where_ $ queryInMetadata query service + where_ (pr ^. PkgRecordHidden ==. val False) pure service Just category -> do - (service :& _ :& cat) <- + (service :& _ :& cat :& pr) <- from $ table @VersionRecord `innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId) `innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b)) + `innerJoin` table @PkgRecord `on` (\(v :& _ :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v)) -- 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_ (pr ^. PkgRecordHidden ==. val False) pure service groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) orderBy @@ -207,14 +213,15 @@ getPkgDependencyData :: MonadIO m => PkgId -> Version -> - ReaderT SqlBackend m [PkgDependency] -getPkgDependencyData pkgId pkgVersion = fmap (fmap entityVal) $ + ReaderT SqlBackend m [(P.Entity PkgDependency, P.Entity PkgRecord)] +getPkgDependencyData pkgId pkgVersion = select $ from $ do - pkgDepRecord <- from $ table @PkgDependency + (pkgDepRecord :& pr) <- from $ table @PkgDependency + `innerJoin` table @PkgRecord `on` (\(v :& p) -> (PkgRecordId === PkgDependencyPkgId) (p :& v)) where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val (PkgRecordKey pkgId)) where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion) - pure pkgDepRecord + pure (pkgDepRecord, pr) (===) :: @@ -307,6 +314,7 @@ upsertPackageVersion PackageManifest{..} = do VersionRecord now (Just now) + Nothing pkgId packageManifestVersion packageManifestTitle @@ -315,7 +323,7 @@ upsertPackageVersion PackageManifest{..} = do iconType packageManifestReleaseNotes packageManifestEosVersion - _res <- try @_ @SomeException $ insertKey pkgId (PkgRecord now (Just now)) + _res <- try @_ @SomeException $ insertKey pkgId (PkgRecord False now (Just now)) repsert (VersionRecordKey pkgId packageManifestVersion) ins upsertPackageVersionPlatform :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m () diff --git a/src/Handler/Eos/V0/Latest.hs b/src/Handler/Eos/V0/Latest.hs index 8d44a14..3ad5480 100644 --- a/src/Handler/Eos/V0/Latest.hs +++ b/src/Handler/Eos/V0/Latest.hs @@ -26,7 +26,7 @@ import Orphans.Emver () import Startlude (Down (..), Eq, Generic, Maybe (..), Ord ((<)), Show, Text, filter, fst, head, pure, sortOn, ($), (&&&), (.), (<$>), (<&>), (<=)) import Yesod (ToContent (toContent), ToTypedContent (..), YesodPersist (runDB), getsYesod) import Yesod.Core.Types (JSONResponse (..)) -import Settings (AppSettings(maxEosVersion)) +import Settings (AppSettings(maxOsVersion)) import Lib.Types.Core (OsArch(RASPBERRYPI)) import Data.Maybe (fromMaybe) @@ -50,7 +50,7 @@ getEosVersionR :: Handler (JSONResponse (Maybe EosRes)) getEosVersionR = do currentEosVersion <- fromMaybe Version { unVersion = (0,3,0,0) } <$> queryParamAs "eos-version" parseVersion arch <- fromMaybe RASPBERRYPI <$> getArchQuery - maxVersion <- getsYesod $ maxEosVersion . appSettings + maxVersion <- getsYesod $ maxOsVersion . appSettings allEosVersions <- runDB $ select $ do vers <- from $ table @OsVersion diff --git a/src/Handler/Package/Api.hs b/src/Handler/Package/Api.hs index 7804b86..7a3b0c7 100644 --- a/src/Handler/Package/Api.hs +++ b/src/Handler/Package/Api.hs @@ -17,6 +17,7 @@ import Startlude ( ByteString, Eq, Generic, + Bool, NonEmpty, Show, Text, @@ -76,10 +77,11 @@ instance ApiResponse PackageRes where data DependencyRes = DependencyRes { dependencyResTitle :: !Text , dependencyResIcon :: !(ContentType, ByteString) + , dependencyResHidden :: !Bool } deriving (Eq, Show) instance ApiResponse DependencyRes where - apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle] - apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle] + apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle, "hidden" .= dependencyResHidden] + apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle, "hidden" .= dependencyResHidden] diff --git a/src/Handler/Package/V0/Latest.hs b/src/Handler/Package/V0/Latest.hs index 102def0..06ff4fd 100644 --- a/src/Handler/Package/V0/Latest.hs +++ b/src/Handler/Package/V0/Latest.hs @@ -9,16 +9,18 @@ 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) +import Foundation (Handler, RegistryCtx (appSettings)) import Handler.Package.V1.Index (getOsVersionQuery) import Lib.Error (S9Error (..)) import Lib.Types.Core (PkgId) -import Lib.Types.Emver (Version, satisfies) +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 Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus) -import Handler.Util (getArchQuery) +import Handler.Util (getArchQuery, filterDeprecatedVersions) +import Yesod.Core (getsYesod) +import Settings (AppSettings(minOsVersion)) newtype VersionLatestRes = VersionLatestRes (HashMap PkgId (Maybe Version)) @@ -38,6 +40,7 @@ getVersionLatestR = do Nothing -> const True Just v -> flip satisfies v osArch <- getArchQuery + minOsVersion <- getsYesod $ minOsVersion . appSettings do case lookup "ids" getParameters of Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "") @@ -54,6 +57,8 @@ getVersionLatestR = do .| collateVersions -- filter out versions of apps that are incompatible with the OS predicate .| mapC (second (filter (osPredicate' . versionRecordOsVersion))) + -- filter out deprecated service versions after a min os version + .| mapC (second (filterDeprecatedVersions minOsVersion osPredicate')) -- prune empty version sets .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) -- grab the latest matching version if it exists @@ -65,4 +70,4 @@ getVersionLatestR = do HM.union (HM.fromList $ filteredPackages) (HM.fromList packageList) where selectLatestVersion :: NonEmpty VersionRecord -> Version - selectLatestVersion vs = NE.head $ (versionRecordNumber <$>) $ NE.sortOn (Down . versionRecordNumber) $ vs + selectLatestVersion vs = NE.head $ (versionRecordNumber <$>) $ NE.sortOn (Down . versionRecordNumber) $ vs \ No newline at end of file diff --git a/src/Handler/Package/V1/Index.hs b/src/Handler/Package/V1/Index.hs index ce39c1c..8ae8c07 100644 --- a/src/Handler/Package/V1/Index.hs +++ b/src/Handler/Package/V1/Index.hs @@ -25,16 +25,16 @@ import Database.Queries ( getPkgDependencyData, serviceQuerySource, ) -import Foundation (Handler, Route (InstructionsR, LicenseR)) +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, getArchQuery) +import Handler.Util (basicRender, parseQueryParam, getArchQuery, filterDeprecatedVersions) import Lib.PkgRepository (PkgRepo, getIcon, getManifest) import Lib.Types.Core (PkgId) import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||)) -import Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..)) +import Model (Category (..), Key (..), PkgDependency (..), VersionRecord (..), PkgRecord (pkgRecordHidden)) import Protolude.Unsafe (unsafeFromJust) -import Settings (AppSettings) +import Settings (AppSettings (minOsVersion)) import Startlude ( Applicative ((*>)), Bifunctor (..), @@ -87,6 +87,9 @@ import Yesod ( YesodPersist (runDB), lookupGetParam, ) +import Data.Tuple (fst) +import Database.Persist.Postgresql (entityVal) +import Yesod.Core (getsYesod) data PackageReq = PackageReq { packageReqId :: !PkgId @@ -115,7 +118,8 @@ getPackageIndexR = do getOsVersionQuery <&> \case Nothing -> const True Just v -> flip satisfies v - osArch <- getArchQuery + osArch <- getArchQuery + minOsVersion <- getsYesod $ minOsVersion . appSettings do pkgIds <- getPkgIdsQuery category <- getCategoryQuery @@ -136,6 +140,8 @@ getPackageIndexR = do .| collateVersions -- filter out versions of apps that are incompatible with the OS predicate .| mapC (second (filter (osPredicate . versionRecordOsVersion))) + -- filter out deprecated service versions after a min os version + .| mapC (second (filterDeprecatedVersions minOsVersion osPredicate)) -- prune empty version sets .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) -- grab the latest matching version if it exists @@ -177,15 +183,16 @@ getPackageDependencies :: ReaderT SqlBackend m (HashMap PkgId DependencyRes) getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} = do - pkgDepInfo <- getPkgDependencyData pkg pkgVersion - pkgDepInfoWithVersions <- traverse getDependencyVersions pkgDepInfo + pkgDepInfo' <- getPkgDependencyData pkg pkgVersion + let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo' + pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo) let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions let depMetadata = catMaybes $ zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo lift $ fmap HM.fromList $ - for depMetadata $ \(depId, title, v) -> do + for depMetadata $ \(depId, title, v, isLocal) -> do icon <- loadIcon depId v - pure $ (depId, DependencyRes title icon) + pure $ (depId, DependencyRes title icon isLocal) constructPackageListApiRes :: @@ -237,11 +244,13 @@ selectLatestVersionFromSpec pkgRanges vs = -- get best version of the dependency based on what is specified in the db (ie. what is specified in the manifest for the package) -selectDependencyBestVersion :: PkgDependency -> [VersionRecord] -> Maybe (PkgId, Text, Version) -selectDependencyBestVersion pkgDepRecord depVersions = do +selectDependencyBestVersion :: (PkgDependency, PkgRecord) -> [VersionRecord] -> Maybe (PkgId, Text, Version, Bool) +selectDependencyBestVersion pkgDepInfo depVersions = do + let pkgDepRecord = fst pkgDepInfo + let isLocal = pkgRecordHidden $ snd pkgDepInfo let depId = pkgDependencyDepId pkgDepRecord let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions case maximumOn versionRecordNumber satisfactory of - Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion) + Just bestVersion -> Just (unPkgRecordKey depId, versionRecordTitle bestVersion, versionRecordNumber bestVersion, isLocal) Nothing -> Nothing diff --git a/src/Handler/Util.hs b/src/Handler/Util.hs index c57e2c9..6cdf91e 100644 --- a/src/Handler/Util.hs +++ b/src/Handler/Util.hs @@ -25,13 +25,13 @@ import Lib.PkgRepository ( ) import Lib.Types.Core (PkgId, OsArch) import Lib.Types.Emver ( - Version, + Version (Version, unVersion), VersionRange, satisfies, parseVersion ) import Model ( UserActivity (..), - VersionRecord (versionRecordOsVersion), + VersionRecord (versionRecordOsVersion, versionRecordDeprecatedAt), ) import Network.HTTP.Types ( Status, @@ -79,6 +79,7 @@ import Yesod ( ) import Yesod.Core (addHeader, logWarn) import Lib.Error (S9Error (..)) +import Data.Maybe (isJust) orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a orThrow action other = @@ -174,4 +175,10 @@ fetchCompatiblePkgVersions osVersion pkg = do Just v -> flip satisfies v getArchQuery :: Handler (Maybe OsArch) -getArchQuery = parseQueryParam "arch" ((flip $ note . mappend "Invalid 'arch': ") =<< readMaybe) \ No newline at end of file +getArchQuery = parseQueryParam "arch" ((flip $ note . mappend "Invalid 'arch': ") =<< readMaybe) + +filterDeprecatedVersions :: Version -> (Version -> Bool) -> [VersionRecord] -> [VersionRecord] +filterDeprecatedVersions minOsVersion osPredicate vrs = do + if (osPredicate minOsVersion) + then filter (\v -> not $ isJust $ versionRecordDeprecatedAt v) $ vrs + else vrs \ No newline at end of file diff --git a/src/Lib/PkgRepository.hs b/src/Lib/PkgRepository.hs index ba1cdf5..1307eff 100644 --- a/src/Lib/PkgRepository.hs +++ b/src/Lib/PkgRepository.hs @@ -206,7 +206,7 @@ loadPkgDependencies appConnPool manifest = do time <- liftIO getCurrentTime _ <- runWith appConnPool $ - insertKey (PkgRecordKey pkgId) (PkgRecord time Nothing) `catch` \(e :: SqlError) -> + insertKey (PkgRecordKey pkgId) (PkgRecord False time Nothing) `catch` \(e :: SqlError) -> -- 23505 is "already exists" if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e let deps' = first PkgRecordKey <$> HM.toList deps @@ -215,7 +215,7 @@ loadPkgDependencies appConnPool manifest = do ( \d -> flip runSqlPool appConnPool $ do _ <- runWith appConnPool $ - insertKey (fst d) (PkgRecord time Nothing) `catch` \(e :: SqlError) -> + insertKey (fst d) (PkgRecord False time Nothing) `catch` \(e :: SqlError) -> -- 23505 is "already exists" if sqlState e == "23505" then update (fst d) [PkgRecordUpdatedAt =. Just time] else throwIO e insertUnique $ diff --git a/src/Model.hs b/src/Model.hs index e1a8509..cb8f24c 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -36,6 +36,7 @@ import Startlude ( Text, UTCTime, Word32, + Bool ) @@ -44,6 +45,7 @@ share [persistLowerCase| PkgRecord Id PkgId sql=pkg_id + hidden Bool default=False createdAt UTCTime updatedAt UTCTime Maybe deriving Eq @@ -52,6 +54,7 @@ PkgRecord VersionRecord sql=version createdAt UTCTime updatedAt UTCTime Maybe + deprecatedAt UTCTime Maybe pkgId PkgRecordId number Version title Text diff --git a/src/Settings.hs b/src/Settings.hs index b8278f0..02bf7e7 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -75,7 +75,8 @@ data AppSettings = AppSettings -- ^ Should all log messages be displayed? , errorLogRoot :: !FilePath , marketplaceName :: !Text - , maxEosVersion :: !Version + , maxOsVersion :: !Version + , minOsVersion :: !Version , registryHostname :: !Text , registryVersion :: !Version , resourcesDir :: !FilePath @@ -110,7 +111,8 @@ instance FromJSON AppSettings where appShouldLogAll <- o .:? "should-log-all" .!= False errorLogRoot <- o .: "error-log-root" marketplaceName <- o .: "marketplace-name" - maxEosVersion <- o .: "max-eos-version" + maxOsVersion <- o .: "max-eos-version" + minOsVersion <- o .: "min-eos-version" registryHostname <- o .: "registry-hostname" resourcesDir <- o .: "resources-path" needsMigration <- o .: "run-migration"