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

fix whitelist logic and default it to empty

Browse Source
This commit is contained in:
Lucy Cifferello
2023-04-12 17:01:19 -06:00
parent cf8b386c53
commit fa40f6f7a2
2 changed files with 7 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/Handler/Admin.hs
View File

@@ -117,7 +117,9 @@ import Startlude (
(<<$>>),
(<>),
(>),
(&&)
(&&),
(||),
(<=)
)
import System.FilePath (
(<.>),
@@ -165,9 +167,8 @@ postPkgUploadR = do
PackageManifest{..} <- do
liftIO (decodeFileStrict (dir </> "manifest.json"))
`orThrow` sendResponseText status500 "Failed to parse manifest.json"
if (not $ elem packageManifestId whitelist && (length whitelist > 0))
then sendResponseText status500 "Package does not belong on this registry."
else do
if ((length whitelist > 0 && (packageManifestId `elem` whitelist)) || length whitelist <= 0)
then do
renameFile path (dir </> (toS . unPkgId) packageManifestId <.> "s9pk")
let targetPath = pkgRepoFileRoot </> show packageManifestId </> show packageManifestVersion
removePathForcibly targetPath
@@ -181,6 +182,7 @@ postPkgUploadR = do
Just name -> do
now <- liftIO getCurrentTime
runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now)
else sendResponseText status500 "Package does not belong on this registry."
where
retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m)