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

implements query parameter for prioritizing lower versions

Browse Source
This commit is contained in:
Keagan McClelland
2022-01-26 14:46:41 -07:00
parent 796128d78a
commit b43d85ea63
5 changed files with 43 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
src/Handler/Apps.hs
View File

@@ -50,6 +50,7 @@ import Lib.Types.Emver ( Version )
import Util.Shared ( addPackageHeader
, getVersionSpecFromQuery
, orThrow
, versionPriorityFromQueryIsMin
)
data FileExtension = FileExtension FilePath (Maybe String)
@@ -60,7 +61,8 @@ instance Show FileExtension where
getAppManifestR :: PkgId -> Handler TypedContent
getAppManifestR pkg = do
versionSpec <- getVersionSpecFromQuery
version <- getBestVersion pkg versionSpec
preferMin <- versionPriorityFromQueryIsMin
version <- getBestVersion pkg versionSpec preferMin
`orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
addPackageHeader pkg version
(len, src) <- getManifest pkg version
@@ -71,7 +73,8 @@ getAppR :: S9PK -> Handler TypedContent
getAppR file = do
let pkg = PkgId . T.pack $ takeBaseName (show file)
versionSpec <- getVersionSpecFromQuery
version <- getBestVersion pkg versionSpec
preferMin <- versionPriorityFromQueryIsMin
version <- getBestVersion pkg versionSpec preferMin
`orThrow` sendResponseStatus status404 (NotFoundE [i|#{pkg} satisfying #{versionSpec}|])
addPackageHeader pkg version
void $ recordMetrics pkg version

15
src/Handler/Icons.hs
View File

@@ -34,8 +34,9 @@ instance FromJSON IconType
getIconsR :: PkgId -> Handler TypedContent
getIconsR pkg = do
spec <- getVersionSpecFromQuery
version <- getBestVersion pkg spec
spec <- getVersionSpecFromQuery
preferMin <- versionPriorityFromQueryIsMin
version <- getBestVersion pkg spec preferMin
`orThrow` sendResponseStatus status400 (NotFoundE [i|Icon for #{pkg} satisfying #{spec}|])
(ct, len, src) <- getIcon pkg version
addHeader "Content-Length" (show len)
@@ -43,8 +44,9 @@ getIconsR pkg = do
getLicenseR :: PkgId -> Handler TypedContent
getLicenseR pkg = do
spec <- getVersionSpecFromQuery
version <- getBestVersion pkg spec
spec <- getVersionSpecFromQuery
preferMin <- versionPriorityFromQueryIsMin
version <- getBestVersion pkg spec preferMin
`orThrow` sendResponseStatus status400 (NotFoundE [i|License for #{pkg} satisfying #{spec}|])
(len, src) <- getLicense pkg version
addHeader "Content-Length" (show len)
@@ -52,8 +54,9 @@ getLicenseR pkg = do
getInstructionsR :: PkgId -> Handler TypedContent
getInstructionsR pkg = do
spec <- getVersionSpecFromQuery
version <- getBestVersion pkg spec
spec <- getVersionSpecFromQuery
preferMin <- versionPriorityFromQueryIsMin
version <- getBestVersion pkg spec preferMin
`orThrow` sendResponseStatus status400 (NotFoundE [i|Instructions for #{pkg} satisfying #{spec}|])
(len, src) <- getInstructions pkg version
addHeader "Content-Length" (show len)

6
src/Handler/Version.hs
View File

@@ -21,11 +21,13 @@ import Lib.Types.AppIndex ( PkgId )
import Network.HTTP.Types.Status ( status404 )
import Util.Shared ( getVersionSpecFromQuery
, orThrow
, versionPriorityFromQueryIsMin
)
getPkgVersionR :: PkgId -> Handler AppVersionRes
getPkgVersionR pkg = do
spec <- getVersionSpecFromQuery
AppVersionRes <$> getBestVersion pkg spec `orThrow` sendResponseStatus
spec <- getVersionSpecFromQuery
preferMin <- versionPriorityFromQueryIsMin
AppVersionRes <$> getBestVersion pkg spec preferMin `orThrow` sendResponseStatus
status404
(NotFoundE [i|Version for #{pkg} satisfying #{spec}|])

21
src/Lib/PkgRepository.hs
View File

@@ -1,11 +1,12 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Lib.PkgRepository where
import Conduit ( (.|)
@@ -70,6 +71,7 @@ import Startlude ( ($)
, Maybe(..)
, MonadIO(liftIO)
, MonadReader
, Ord(compare)
, Show
, SomeException(..)
, filter
@@ -79,11 +81,12 @@ import Startlude ( ($)
, fst
, headMay
, not
, on
, partitionEithers
, pure
, show
, snd
, sortOn
, sortBy
, throwIO
, void
)
@@ -105,9 +108,9 @@ import UnliftIO ( MonadUnliftIO
, mapConcurrently_
, newEmptyMVar
, takeMVar
, tryPutMVar
, wait
)
import UnliftIO ( tryPutMVar )
import UnliftIO.Concurrent ( forkIO )
import UnliftIO.Directory ( doesDirectoryExist
, doesPathExist
@@ -124,6 +127,7 @@ import Yesod.Core.Content ( typeGif
, typeSvg
)
import Yesod.Core.Types ( ContentType )
data ManifestParseException = ManifestParseException FilePath
deriving Show
instance Exception ManifestParseException
@@ -152,8 +156,10 @@ getViableVersions pkg spec = filter (`satisfies` spec) <$> getVersionsFor pkg
getBestVersion :: (MonadIO m, MonadReader r m, Has PkgRepo r, MonadLogger m)
=> PkgId
-> VersionRange
-> Bool
-> m (Maybe Version)
getBestVersion pkg spec = headMay . sortOn Down <$> getViableVersions pkg spec
getBestVersion pkg spec preferMin = headMay . sortBy comparator <$> getViableVersions pkg spec
where comparator = if preferMin then compare else compare `on` Down
loadPkgDependencies :: MonadUnliftIO m => ConnectionPool -> PackageManifest -> m ()
loadPkgDependencies appConnPool manifest = do
@@ -234,7 +240,6 @@ watchPkgRepoRoot pool = do
onlyAdded (Added path _ isDir) = not isDir && takeExtension path == ".s9pk"
onlyAdded (Modified path _ isDir) = not isDir && takeExtension path == ".s9pk"
onlyAdded _ = False
-- Added path _ isDir -> not isDir && takeExtension path == ".s9pk"
getManifest :: (MonadResource m, MonadReader r m, Has PkgRepo r)
=> PkgId

16
src/Util/Shared.hs
View File

@@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Util.Shared where
@@ -54,6 +54,15 @@ getVersionSpecFromQuery = do
Nothing -> sendResponseStatus status400 ("Invalid App Version Specification" :: Text)
Just t -> pure t
versionPriorityFromQueryIsMin :: Handler Bool
versionPriorityFromQueryIsMin = do
priorityString <- lookupGetParam "version-priority"
case priorityString of
Nothing -> pure False
(Just "max") -> pure False
(Just "min") -> pure True
(Just t ) -> sendResponseStatus status400 ("Invalid Version Priority Specification: " <> t)
addPackageHeader :: (MonadUnliftIO m, MonadHandler m, MonadReader r m, Has PkgRepo r) => PkgId -> Version -> m ()
addPackageHeader pkg version = do
packageHash <- getHash pkg version
@@ -64,7 +73,6 @@ orThrow action other = action >>= \case
Nothing -> other
Just x -> pure x
filterPkgOsCompatible :: Monad m => (Version -> Bool) -> ConduitT PackageMetadata PackageMetadata m ()
filterPkgOsCompatible p =
awaitForever
@@ -109,7 +117,7 @@ filterLatestVersionFromSpec versionMap = awaitForever $ \(a, vs, cats) -> do
filterDependencyBestVersion :: MonadLogger m => PackageDependencyMetadata -> m (Maybe (Key PkgRecord, Text, Version))
filterDependencyBestVersion PackageDependencyMetadata { packageDependencyMetadataPkgDependencyRecord = pkgDepRecord, packageDependencyMetadataDepPkgRecord = depRecord, packageDependencyMetadataDepVersions = depVersions }
= do
-- get best version from VersionRange of dependency
-- get best version from VersionRange of dependency
let pkgId = pkgDependencyPkgId $ entityVal pkgDepRecord
let depId = pkgDependencyDepId $ entityVal pkgDepRecord
let depTitle = pkgRecordTitle $ entityVal depRecord
@@ -119,6 +127,6 @@ filterDependencyBestVersion PackageDependencyMetadata { packageDependencyMetadat
-- QUESTION is this an acceptable transformation here? These are the only values that we care about after this filter.
Just bestVersion -> pure $ Just (depId, depTitle, bestVersion)
Nothing -> do
$logInfo [i|No satisfactory version of #{depId} for dependent package #{pkgId}|]
-- TODO it would be better if we could return the requirements for display
$logInfo [i|No satisfactory version of #{depId} for dependent package #{pkgId}|]
pure Nothing