Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 02:11:53 +00:00
Code Issues Packages Projects Releases Wiki Activity

Feat/local packages (#133)

Browse Source 
* enable packages to be marked as unavailable locally

* change isLocal column to hidden

* add option to deprecate a service version based on a min os version
This commit is contained in:
Lucy C
2023-04-11 19:08:53 -06:00
committed by GitHub
parent 4d6db96c0c
commit 35500cfc02
10 changed files with 78 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
config/settings.yml
View File

@@ -36,7 +36,8 @@ tor-port: "_env:TOR_PORT:447"
static-bin-dir: "_env:STATIC_BIN:/usr/local/bin/" static-bin-dir: "_env:STATIC_BIN:/usr/local/bin/"
error-log-root: "_env:ERROR_LOG_ROOT:/var/log/registry/" error-log-root: "_env:ERROR_LOG_ROOT:/var/log/registry/"
marketplace-name: "_env:MARKETPLACE_NAME:CHANGE ME" 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" run-migration: "_env:RUN_MIGRATION:false"
database: database:

34
src/Database/Queries.hs
View File

@@ -31,7 +31,7 @@ import Startlude (
getCurrentTime, getCurrentTime,
maybe, maybe,
($), ($),
(.), (.), Bool (False),
) )
import System.FilePath (takeExtension) import System.FilePath (takeExtension)
import UnliftIO ( import UnliftIO (
@@ -97,7 +97,7 @@ import Model (
VersionRecordNumber, VersionRecordNumber,
VersionRecordPkgId, VersionRecordPkgId,
VersionRecordTitle, VersionRecordTitle,
VersionRecordUpdatedAt VersionRecordUpdatedAt, PkgRecordHidden
), ),
Key (unPkgRecordKey), Key (unPkgRecordKey),
PkgCategory, PkgCategory,
@@ -105,7 +105,6 @@ import Model (
) )
import Startlude ( import Startlude (
Applicative (pure), Applicative (pure),
Bool,
Down (Down), Down (Down),
Eq ((==)), Eq ((==)),
Functor (fmap), Functor (fmap),
@@ -118,7 +117,6 @@ import Startlude (
(<$>), (<$>),
) )
serviceQuerySource :: serviceQuerySource ::
(MonadResource m, MonadIO m) => (MonadResource m, MonadIO m) =>
Maybe Text -> Maybe Text ->
@@ -130,24 +128,28 @@ serviceQuerySource mCat query mOsArch = selectSource $ do
Just osArch -> do Just osArch -> do
service <- case mCat of service <- case mCat of
Nothing -> do 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 @VersionPlatform `on` (\(service :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service))
`innerJoin` table @PkgRecord `on` (\(v :& _ :& p) -> (PkgRecordId === VersionRecordPkgId) (p :& v))
where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
where_ (vp ^. VersionPlatformArch ==. val osArch) where_ (vp ^. VersionPlatformArch ==. val osArch)
where_ (pr ^. PkgRecordHidden ==. val False)
where_ $ queryInMetadata query service where_ $ queryInMetadata query service
pure service pure service
Just category -> do Just category -> do
(service :& _ :& cat :& vp) <- (service :& _ :& cat :& vp :& pr) <-
from $ from $
table @VersionRecord table @VersionRecord
`innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId) `innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId)
`innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b)) `innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b))
`innerJoin` table @VersionPlatform `on` (\(service :& _ :& _ :& vp) -> (VersionPlatformPkgId === VersionRecordPkgId) (vp :& service)) `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 -- if there is a cateogry, only search in category
-- weight title, short, long (bitcoin should equal Bitcoin Core) -- weight title, short, long (bitcoin should equal Bitcoin Core)
where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service
where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber) where_ (service ^. VersionRecordNumber ==. vp ^. VersionPlatformVersionNumber)
where_ (vp ^. VersionPlatformArch ==. val osArch) where_ (vp ^. VersionPlatformArch ==. val osArch)
where_ (pr ^. PkgRecordHidden ==. val False)
pure service pure service
groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber)
orderBy orderBy
@@ -159,18 +161,22 @@ serviceQuerySource mCat query mOsArch = selectSource $ do
Nothing -> do Nothing -> do
service <- case mCat of service <- case mCat of
Nothing -> do 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_ $ queryInMetadata query service
where_ (pr ^. PkgRecordHidden ==. val False)
pure service pure service
Just category -> do Just category -> do
(service :& _ :& cat) <- (service :& _ :& cat :& pr) <-
from $ from $
table @VersionRecord table @VersionRecord
`innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId) `innerJoin` table @PkgCategory `on` (VersionRecordPkgId === PkgCategoryPkgId)
`innerJoin` table @Category `on` (\(_ :& a :& b) -> (PkgCategoryCategoryId === CategoryId) (a :& b)) `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 -- if there is a cateogry, only search in category
-- weight title, short, long (bitcoin should equal Bitcoin Core) -- weight title, short, long (bitcoin should equal Bitcoin Core)
where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service where_ $ cat ^. CategoryName ==. val category &&. queryInMetadata query service
where_ (pr ^. PkgRecordHidden ==. val False)
pure service pure service
groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber) groupBy (service ^. VersionRecordPkgId, service ^. VersionRecordNumber)
orderBy orderBy
@@ -207,14 +213,15 @@ getPkgDependencyData ::
MonadIO m => MonadIO m =>
PkgId -> PkgId ->
Version -> Version ->
ReaderT SqlBackend m [PkgDependency] ReaderT SqlBackend m [(P.Entity PkgDependency, P.Entity PkgRecord)]
getPkgDependencyData pkgId pkgVersion = fmap (fmap entityVal) $ getPkgDependencyData pkgId pkgVersion =
select $ select $
from $ do 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 ^. PkgDependencyPkgId ==. val (PkgRecordKey pkgId))
where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion) where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion)
pure pkgDepRecord pure (pkgDepRecord, pr)
(===) :: (===) ::
@@ -307,6 +314,7 @@ upsertPackageVersion PackageManifest{..} = do
VersionRecord VersionRecord
now now
(Just now) (Just now)
Nothing
pkgId pkgId
packageManifestVersion packageManifestVersion
packageManifestTitle packageManifestTitle
@@ -315,7 +323,7 @@ upsertPackageVersion PackageManifest{..} = do
iconType iconType
packageManifestReleaseNotes packageManifestReleaseNotes
packageManifestEosVersion 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 repsert (VersionRecordKey pkgId packageManifestVersion) ins
upsertPackageVersionPlatform :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m () upsertPackageVersionPlatform :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m ()

4
src/Handler/Eos/V0/Latest.hs
View File

@@ -26,7 +26,7 @@ import Orphans.Emver ()
import Startlude (Down (..), Eq, Generic, Maybe (..), Ord ((<)), Show, Text, filter, fst, head, pure, sortOn, ($), (&&&), (.), (<$>), (<&>), (<=)) import Startlude (Down (..), Eq, Generic, Maybe (..), Ord ((<)), Show, Text, filter, fst, head, pure, sortOn, ($), (&&&), (.), (<$>), (<&>), (<=))
import Yesod (ToContent (toContent), ToTypedContent (..), YesodPersist (runDB), getsYesod) import Yesod (ToContent (toContent), ToTypedContent (..), YesodPersist (runDB), getsYesod)
import Yesod.Core.Types (JSONResponse (..)) import Yesod.Core.Types (JSONResponse (..))
import Settings (AppSettings(maxEosVersion)) import Settings (AppSettings(maxOsVersion))
import Lib.Types.Core (OsArch(RASPBERRYPI)) import Lib.Types.Core (OsArch(RASPBERRYPI))
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@@ -50,7 +50,7 @@ getEosVersionR :: Handler (JSONResponse (Maybe EosRes))
getEosVersionR = do getEosVersionR = do
currentEosVersion <- fromMaybe Version { unVersion = (0,3,0,0) } <$> queryParamAs "eos-version" parseVersion currentEosVersion <- fromMaybe Version { unVersion = (0,3,0,0) } <$> queryParamAs "eos-version" parseVersion
arch <- fromMaybe RASPBERRYPI <$> getArchQuery arch <- fromMaybe RASPBERRYPI <$> getArchQuery
maxVersion <- getsYesod $ maxEosVersion . appSettings maxVersion <- getsYesod $ maxOsVersion . appSettings
allEosVersions <- runDB $ allEosVersions <- runDB $
select $ do select $ do
vers <- from $ table @OsVersion vers <- from $ table @OsVersion

6
src/Handler/Package/Api.hs
View File

@@ -17,6 +17,7 @@ import Startlude (
ByteString, ByteString,
Eq, Eq,
Generic, Generic,
Bool,
NonEmpty, NonEmpty,
Show, Show,
Text, Text,
@@ -76,10 +77,11 @@ instance ApiResponse PackageRes where
data DependencyRes = DependencyRes data DependencyRes = DependencyRes
{ dependencyResTitle :: !Text { dependencyResTitle :: !Text
, dependencyResIcon :: !(ContentType, ByteString) , dependencyResIcon :: !(ContentType, ByteString)
, dependencyResHidden :: !Bool
} }
deriving (Eq, Show) deriving (Eq, Show)
instance ApiResponse DependencyRes where instance ApiResponse DependencyRes where
apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle] apiEncode V0 DependencyRes{..} = object ["icon" .= encodeBase64 (snd dependencyResIcon), "title" .= dependencyResTitle, "hidden" .= dependencyResHidden]
apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle] apiEncode V1 DependencyRes{..} = object ["icon" .= dataUrl dependencyResIcon, "title" .= dependencyResTitle, "hidden" .= dependencyResHidden]

11
src/Handler/Package/V0/Latest.hs
View File

@@ -9,16 +9,18 @@ import Data.List (lookup)
import Data.List.NonEmpty.Extra qualified as NE import Data.List.NonEmpty.Extra qualified as NE
import Data.Tuple.Extra (second) import Data.Tuple.Extra (second)
import Database.Queries (collateVersions, getPkgDataSource) import Database.Queries (collateVersions, getPkgDataSource)
import Foundation (Handler) import Foundation (Handler, RegistryCtx (appSettings))
import Handler.Package.V1.Index (getOsVersionQuery) import Handler.Package.V1.Index (getOsVersionQuery)
import Lib.Error (S9Error (..)) import Lib.Error (S9Error (..))
import Lib.Types.Core (PkgId) import Lib.Types.Core (PkgId)
import Lib.Types.Emver (Version, satisfies) import Lib.Types.Emver (Version (..), satisfies)
import Model (VersionRecord (..)) import Model (VersionRecord (..))
import Network.HTTP.Types (status400) 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, ($), (.), (<$>), (<&>))
import Yesod (ToContent (..), ToTypedContent (..), YesodPersist (runDB), YesodRequest (reqGetParams), getRequest, sendResponseStatus) 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)) newtype VersionLatestRes = VersionLatestRes (HashMap PkgId (Maybe Version))
@@ -38,6 +40,7 @@ getVersionLatestR = do
Nothing -> const True Nothing -> const True
Just v -> flip satisfies v Just v -> flip satisfies v
osArch <- getArchQuery osArch <- getArchQuery
minOsVersion <- getsYesod $ minOsVersion . appSettings
do do
case lookup "ids" getParameters of case lookup "ids" getParameters of
Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "<MISSING>") Nothing -> sendResponseStatus status400 (InvalidParamsE "get:ids" "<MISSING>")
@@ -54,6 +57,8 @@ getVersionLatestR = do
.| collateVersions .| collateVersions
-- filter out versions of apps that are incompatible with the OS predicate -- filter out versions of apps that are incompatible with the OS predicate
.| mapC (second (filter (osPredicate' . versionRecordOsVersion))) .| mapC (second (filter (osPredicate' . versionRecordOsVersion)))
-- filter out deprecated service versions after a min os version
.| mapC (second (filterDeprecatedVersions minOsVersion osPredicate'))
-- prune empty version sets -- prune empty version sets
.| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
-- grab the latest matching version if it exists -- grab the latest matching version if it exists

31
src/Handler/Package/V1/Index.hs
View File

@@ -25,16 +25,16 @@ import Database.Queries (
getPkgDependencyData, getPkgDependencyData,
serviceQuerySource, serviceQuerySource,
) )
import Foundation (Handler, Route (InstructionsR, LicenseR)) import Foundation (Handler, Route (InstructionsR, LicenseR), RegistryCtx (appSettings))
import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..)) import Handler.Package.Api (DependencyRes (..), PackageListRes (..), PackageRes (..))
import Handler.Types.Api (ApiVersion (..)) 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.PkgRepository (PkgRepo, getIcon, getManifest)
import Lib.Types.Core (PkgId) import Lib.Types.Core (PkgId)
import Lib.Types.Emver (Version, VersionRange (..), parseRange, satisfies, (<||)) 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 Protolude.Unsafe (unsafeFromJust)
import Settings (AppSettings) import Settings (AppSettings (minOsVersion))
import Startlude ( import Startlude (
Applicative ((*>)), Applicative ((*>)),
Bifunctor (..), Bifunctor (..),
@@ -87,6 +87,9 @@ import Yesod (
YesodPersist (runDB), YesodPersist (runDB),
lookupGetParam, lookupGetParam,
) )
import Data.Tuple (fst)
import Database.Persist.Postgresql (entityVal)
import Yesod.Core (getsYesod)
data PackageReq = PackageReq data PackageReq = PackageReq
{ packageReqId :: !PkgId { packageReqId :: !PkgId
@@ -116,6 +119,7 @@ getPackageIndexR = do
Nothing -> const True Nothing -> const True
Just v -> flip satisfies v Just v -> flip satisfies v
osArch <- getArchQuery osArch <- getArchQuery
minOsVersion <- getsYesod $ minOsVersion . appSettings
do do
pkgIds <- getPkgIdsQuery pkgIds <- getPkgIdsQuery
category <- getCategoryQuery category <- getCategoryQuery
@@ -136,6 +140,8 @@ getPackageIndexR = do
.| collateVersions .| collateVersions
-- filter out versions of apps that are incompatible with the OS predicate -- filter out versions of apps that are incompatible with the OS predicate
.| mapC (second (filter (osPredicate . versionRecordOsVersion))) .| mapC (second (filter (osPredicate . versionRecordOsVersion)))
-- filter out deprecated service versions after a min os version
.| mapC (second (filterDeprecatedVersions minOsVersion osPredicate))
-- prune empty version sets -- prune empty version sets
.| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs) .| concatMapC (\(pkgId, vs) -> (pkgId,) <$> nonEmpty vs)
-- grab the latest matching version if it exists -- grab the latest matching version if it exists
@@ -177,15 +183,16 @@ getPackageDependencies ::
ReaderT SqlBackend m (HashMap PkgId DependencyRes) ReaderT SqlBackend m (HashMap PkgId DependencyRes)
getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} = getPackageDependencies osPredicate PackageMetadata{packageMetadataPkgId = pkg, packageMetadataPkgVersion = pkgVersion} =
do do
pkgDepInfo <- getPkgDependencyData pkg pkgVersion pkgDepInfo' <- getPkgDependencyData pkg pkgVersion
pkgDepInfoWithVersions <- traverse getDependencyVersions pkgDepInfo let pkgDepInfo = fmap (\a -> (entityVal $ fst a, entityVal $ snd a)) pkgDepInfo'
pkgDepInfoWithVersions <- traverse getDependencyVersions (fst <$> pkgDepInfo)
let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions let compatiblePkgDepInfo = fmap (filter (osPredicate . versionRecordOsVersion)) pkgDepInfoWithVersions
let depMetadata = catMaybes $ zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo let depMetadata = catMaybes $ zipWith selectDependencyBestVersion pkgDepInfo compatiblePkgDepInfo
lift $ lift $
fmap HM.fromList $ fmap HM.fromList $
for depMetadata $ \(depId, title, v) -> do for depMetadata $ \(depId, title, v, isLocal) -> do
icon <- loadIcon depId v icon <- loadIcon depId v
pure $ (depId, DependencyRes title icon) pure $ (depId, DependencyRes title icon isLocal)
constructPackageListApiRes :: 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) -- 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 :: (PkgDependency, PkgRecord) -> [VersionRecord] -> Maybe (PkgId, Text, Version, Bool)
selectDependencyBestVersion pkgDepRecord depVersions = do selectDependencyBestVersion pkgDepInfo depVersions = do
let pkgDepRecord = fst pkgDepInfo
let isLocal = pkgRecordHidden $ snd pkgDepInfo
let depId = pkgDependencyDepId pkgDepRecord let depId = pkgDependencyDepId pkgDepRecord
let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord let versionRequirement = pkgDependencyDepVersionRange pkgDepRecord
let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions let satisfactory = filter ((<|| versionRequirement) . versionRecordNumber) depVersions
case maximumOn versionRecordNumber satisfactory of 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 Nothing -> Nothing

11
src/Handler/Util.hs
View File

@@ -25,13 +25,13 @@ import Lib.PkgRepository (
) )
import Lib.Types.Core (PkgId, OsArch) import Lib.Types.Core (PkgId, OsArch)
import Lib.Types.Emver ( import Lib.Types.Emver (
Version, Version (Version, unVersion),
VersionRange, VersionRange,
satisfies, parseVersion satisfies, parseVersion
) )
import Model ( import Model (
UserActivity (..), UserActivity (..),
VersionRecord (versionRecordOsVersion), VersionRecord (versionRecordOsVersion, versionRecordDeprecatedAt),
) )
import Network.HTTP.Types ( import Network.HTTP.Types (
Status, Status,
@@ -79,6 +79,7 @@ import Yesod (
) )
import Yesod.Core (addHeader, logWarn) import Yesod.Core (addHeader, logWarn)
import Lib.Error (S9Error (..)) import Lib.Error (S9Error (..))
import Data.Maybe (isJust)
orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a
orThrow action other = orThrow action other =
@@ -175,3 +176,9 @@ fetchCompatiblePkgVersions osVersion pkg = do
getArchQuery :: Handler (Maybe OsArch) getArchQuery :: Handler (Maybe OsArch)
getArchQuery = parseQueryParam "arch" ((flip $ note . mappend "Invalid 'arch': ") =<< readMaybe) 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

4
src/Lib/PkgRepository.hs
View File

@@ -206,7 +206,7 @@ loadPkgDependencies appConnPool manifest = do
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
_ <- _ <-
runWith appConnPool $ 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" -- 23505 is "already exists"
if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e if sqlState e == "23505" then update (PkgRecordKey pkgId) [PkgRecordUpdatedAt =. Just time] else throwIO e
let deps' = first PkgRecordKey <$> HM.toList deps let deps' = first PkgRecordKey <$> HM.toList deps
@@ -215,7 +215,7 @@ loadPkgDependencies appConnPool manifest = do
( \d -> flip runSqlPool appConnPool $ do ( \d -> flip runSqlPool appConnPool $ do
_ <- _ <-
runWith appConnPool $ 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" -- 23505 is "already exists"
if sqlState e == "23505" then update (fst d) [PkgRecordUpdatedAt =. Just time] else throwIO e if sqlState e == "23505" then update (fst d) [PkgRecordUpdatedAt =. Just time] else throwIO e
insertUnique $ insertUnique $

3
src/Model.hs
View File

@@ -36,6 +36,7 @@ import Startlude (
Text, Text,
UTCTime, UTCTime,
Word32, Word32,
Bool
) )
@@ -44,6 +45,7 @@ share
[persistLowerCase| [persistLowerCase|
PkgRecord PkgRecord
Id PkgId sql=pkg_id Id PkgId sql=pkg_id
hidden Bool default=False
createdAt UTCTime createdAt UTCTime
updatedAt UTCTime Maybe updatedAt UTCTime Maybe
deriving Eq deriving Eq
@@ -52,6 +54,7 @@ PkgRecord
VersionRecord sql=version VersionRecord sql=version
createdAt UTCTime createdAt UTCTime
updatedAt UTCTime Maybe updatedAt UTCTime Maybe
deprecatedAt UTCTime Maybe
pkgId PkgRecordId pkgId PkgRecordId
number Version number Version
title Text title Text

6
src/Settings.hs
View File

@@ -75,7 +75,8 @@ data AppSettings = AppSettings
-- ^ Should all log messages be displayed? -- ^ Should all log messages be displayed?
, errorLogRoot :: !FilePath , errorLogRoot :: !FilePath
, marketplaceName :: !Text , marketplaceName :: !Text
, maxEosVersion :: !Version , maxOsVersion :: !Version
, minOsVersion :: !Version
, registryHostname :: !Text , registryHostname :: !Text
, registryVersion :: !Version , registryVersion :: !Version
, resourcesDir :: !FilePath , resourcesDir :: !FilePath
@@ -110,7 +111,8 @@ instance FromJSON AppSettings where
appShouldLogAll <- o .:? "should-log-all" .!= False appShouldLogAll <- o .:? "should-log-all" .!= False
errorLogRoot <- o .: "error-log-root" errorLogRoot <- o .: "error-log-root"
marketplaceName <- o .: "marketplace-name" marketplaceName <- o .: "marketplace-name"
maxEosVersion <- o .: "max-eos-version" maxOsVersion <- o .: "max-eos-version"
minOsVersion <- o .: "min-eos-version"
registryHostname <- o .: "registry-hostname" registryHostname <- o .: "registry-hostname"
resourcesDir <- o .: "resources-path" resourcesDir <- o .: "resources-path"
needsMigration <- o .: "run-migration" needsMigration <- o .: "run-migration"